VERSION = 3.00& toolbox.hgGL{- ..\foxpro.hhfP-_rootPixelsClass1custom_rootcustom %]skU CTIUTHISSHOWTYPEInit,12Z)& ..\foxpro.h֛fP- toolbox.hޜGL{-custom_prgtoolPixelsClass1 _filetool_prgtoolcustom _categoryPixels1 _category toolbox.hTGL{-PixelsPixels_activexcategory1& ..\foxpro.h֛fP- toolbox.hޜGL{-1_toolPixelsClass1_rootPixelsClass_toolcustom _toolbox.vcxcustomClass& ..\foxpro.h֛fP- toolbox.hޜGL{-11custom_dynamiccategory_lbxtoolClass1 _filetool_lbxtool,imagefile = dblabel.bmp Name = "_lbxtool" custom _toolbox.vcx toolbox.hTGL{-_dynamiccategoryInstalled ActiveX controls._activexcategory *openitem Name = "_activexcategory"  _toolbox.vcx& ..\foxpro.h֛fP- toolbox.hޜGL{- _imagetoolPixels toolbox.h6GL{-_dynamiccategoryClass_generalcategory _filetoolPixelsClass1 _category_generalcategory1classtype = CATEGORY Name = "_generalcategory" custom _toolbox.vcx toolbox.h^GL{-Class1_frxtoolPixelsClass1 _filetool_frxtool+imagefile = report.bmp Name = "_frxtool" & ..\foxpro.h֛fP- toolbox.hޜGL{-_apptool _imagetoolcustomClasscustom _toolbox.vcx _toolbox.vcx_dbctool toolbox.hTGL{-1& toolbox.hGL{- ..\foxpro.hƧfP-Pixels1& ..\foxpro.h֛fP- toolbox.hޜGL{-Class1 _filetool_dbctool_projectcategoryPixelsClass1_dynamiccategory_projectcategorycustomcustom1/classtype = TOOL tooltype = Name = "_tool" Name = "_projectcategory"  _toolbox.vcx11 _filteritemPixelsClass_root _filteritemClassName = "_filteritem" custom _toolbox.vcx_root_tool_filterPixelsClass %>mU #T CCfilename%C TC (~C 0ToolboxxU CFILENAMETHIS GETDATAVALUE OEXCEPTIONMESSAGE6,C\>" Name = "_dbctool" PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) ENDPROC PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY MODIFY PROJECT (m.cFilename) NOWAIT CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC omodifycollection allowdroponcontainer classbehavior Set to TRUE to enable class behavior for this file tool. droptexttemplate Template to use when file is dropped as text. *openitem *runitem imagefile = picture.bmp showaslink = .F. allowdroponcontainer = .T. classbehavior = .T. lshowobjectname = .T. lshowproperties = .T. Name = "_imagetool" _PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) oContextMenu.Addmenu(TOOLMENU_RUN_LOC, [oRef.RunItem()]) ENDPROC PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY MODIFY LABEL (m.cFilename) NOWAIT CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC PROCEDURE runitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY LABEL FORM (m.cFilename) PREVIEW NOWAIT CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC  j%{>+Ug C[Crefresh-*Refresh category after running application- cfoxcheckboxUTHIS ADDDATAVALUE%%  CUTHIS SHOWASLINKRUNITEMI*TCR\=\&cFilename (!C 0ToolboxxoA   (kC 0Toolboxx% CU CFILENAMELREFRESH OEXCEPTIONTHIS GETDATAVALUEMESSAGEOENGINE LOADTOOLBOX CUTHISRUNITEMoncreatedatavalues, ondblclickcreatecontextmenurunitemconclickX13A3rq3sqq2qA"1AAAAA32  )*::)PROCEDURE ondragover #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState LOCAL nNewEffect m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState) IF VARTYPE(m.nNewEffect) <> 'N' IF oDataObject.GetFormat(15) && is there a list of files in the drag source? m.nNewEffect = DROPEFFECT_COPY ENDIF ENDIF RETURN m.nNewEffect ENDPROC PROCEDURE ondragdrop #include "foxpro.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord LOCAL nNewEffect LOCAL i LOCAL nFileCnt LOCAL ARRAY aFileList[1] m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord) IF VARTYPE(m.nNewEffect) <> 'N' IF oDataObject.GetFormat(15) IF oDataObject.GetData(15, @aFileList) m.nFileCnt = ALEN(m.aFileList, 1) FOR m.i = 1 TO m.nFileCnt THIS.oEngine.CreateToolsFromFile(THIS.UniqueID, aFileList[m.i]) ENDFOR ENDIF ENDIF ENDIF RETURN m.nNewEffect ENDPROC aPROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) oContextMenu.Addmenu(TOOLMENU_RUN_LOC, [oRef.RunItem()]) ENDPROC PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY MODIFY REPORT (m.cFilename) NOWAIT CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC PROCEDURE runitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY REPORT FORM (m.cFilename) PREVIEW NOWAIT CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC  %>mU6,C\>" Name = "_dbftool"  %#cU #T CCfilename%C TC (~C 0ToolboxxU CFILENAMETHIS GETDATAVALUE OEXCEPTIONMESSAGE #T CCfilename%C R   (|C 0ToolboxxU CFILENAMETHIS GETDATAVALUE OEXCEPTIONMESSAGE\,C\mU #T CCfilename%C T/ : (~C 0ToolboxxU CFILENAMETHIS GETDATAVALUE OEXCEPTIONMESSAGE6,C\ 'L' m.lTextMerge = .F. ENDIF IF m.lTextMerge m.cScrap = TEXTMERGE(m.cScrap, .T., "<<", ">>") ENDIF _cliptext = m.cScrap ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu LOCAL cBaseClass LOCAL oMenuBar oContextMenu.Addmenu(TOOLMENU_COPYTOCLIPBOARD_LOC, [oRef.CopyToClipboard()]) ENDPROC PROCEDURE oncreate * show the property sheet when a text scrap is created manually RETURN THIS.OnShowProperties() ENDPROC PROCEDURE onstartdrag #include "foxpro.h" LPARAMETERS oDataObject, nEffect LOCAL cScrap LOCAL lTextMerge m.cScrap = NVL(THIS.GetDataValue("textscrap"), '') m.lTextMerge = THIS.GetDataValue("evaltextmerge") IF VARTYPE(m.lTextMerge) <> 'L' m.lTextMerge = .F. ENDIF IF m.lTextMerge m.cScrap = TEXTMERGE(m.cScrap) ENDIF oDataObject.SetData(m.cScrap) RETURN DROPEFFECT_COPY + DROPEFFECT_MOVE ENDPROC PROCEDURE oncreatedatavalues #include "toolbox.h" THIS.AddDataValue("textscrap", '', DATAVALUE_TEXTSCRAP_LOC, '', .F., "cfoxeditbox") THIS.AddDataValue("evaltextmerge", .F., DATAVALUE_TEXTMERGE_LOC, '', .F., "cfoxcheckbox") ENDPROC PROCEDURE ondragover #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState LOCAL nNewEffect m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState) IF VARTYPE(m.nNewEffect) <> 'N' IF oDataObject.GetFormat(1) && is there text in the drag source? m.nNewEffect = DROPEFFECT_COPY ENDIF ENDIF RETURN m.nNewEffect ENDPROC PROCEDURE ondragdrop #include "foxpro.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord LOCAL nNewEffect LOCAL cTextScrap m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord) IF VARTYPE(m.nNewEffect) <> 'N' IF oDataObject.GetFormat(1) m.cTextScrap = THIS.GetDragData(oDataObject, 1) THIS.oEngine.CreateToolItemScrap(THIS.UniqueID, m.cTextScrap) ENDIF ENDIF RETURN m.nNewEffect ENDPROC APROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) oContextMenu.Addmenu(TOOLMENU_RUN_LOC, [oRef.RunItem()]) ENDPROC PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY EDITSOURCE(m.cFilename) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC PROCEDURE runitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY DO FORM (m.cFilename) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC S ::n%U+T C%C N%CT  B U ODATAOBJECTNEFFECTNBUTTONNSHIFTNXCOORDNYCOORDNSTATE NNEWEFFECT GETFORMAT'T C%C N%CT C C   B U ODATAOBJECTNEFFECTNBUTTONNSHIFTNXCOORDNYCOORD NNEWEFFECT CTEXTSCRAP GETFORMATTHIS GETDRAGDATAOENGINECREATETOOLITEMSCRAPUNIQUEID ondragover, ondragdrop)1qqAAA3qqrqAAA1 t):PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY EDITSOURCE(m.cFilename) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) ENDPROC B ))%43jU C8CtemplateTemplate- cfoxeditboxNCclasslib Class library- cfoxclassinfo cClassLib6C classname- cClassName@C baseclass Base class- cBaseClass=C objectname Object name- cfoxtextbox@C properties Properties-cfoxpropertyboxUTHIS ADDDATAVALUEC T CW"T CCM foxws3.dbf%C 0{LQ F~CfC H;T C WEBSERVICE  ( ) %C  D#C objectnameloWS  1CtemplateCCtemplate  Cid  Curi  Cwsdl  Cservice  Cport  Cwsml  CclassC  C runbuilderY  T 5C objectnameCC objectname  1CclasslibCCclasslib  3C classnameCC classname  5C propertiesCC properties  C C  T%CWSCursorwQ F BUOTOOLCOLLECTION OTOOLOBJECTNSELECT CFILENAMEWSCURSORTYPETOOLBOXTHISOENGINEGETVIRTUALTOOLOBJECTCLASSNAME SETDATAVALUE GETDATAVALUEUNIQUEIDURIWSDLPORTWSMLTOOLTIP SAVEVIRTUALADDoncreatedatavalues,onrendercategory1a4uqqq!qq!1RR1QcRAAArAAC2]  )) %$dU\,C\ 'N' m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState) ENDIF RETURN m.nNewEffect ENDPROC  >%&fU\,C\ 'N' m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState) ENDIF RETURN m.nNewEffect ENDPROC PROCEDURE customize IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.Customize(THIS.UniqueID) ENDIF ENDPROC PROCEDURE Init #include "toolbox.h" DODEFAULT() THIS.ShowType = SHOWTYPE_CATEGORY ENDPROC PROCEDURE onshowproperties * -- show the properties dialog RETURN THIS.oEngine.ShowCategoryPropertiesForm(THIS) ENDPROC f MMm%z g U   *T CCCtemplate  ,T CCC objectname  %C T loWST  T  &T CCCwsdl  %T CCCuri  )T CCCservice  &T CCCport  $T CCCid  %C nL3T C wsfoxcodeCQffc\_ws3utils.vcxT C  %C OHT CC  ( jT  T C a<<>> ( T   B U CTEMPLATECOBJNAMEOBJNAME OBJECTNAMEWSDLURISERVICEPORTCID OPROXYPREP OPROXYGEN OEXCEPTIONTHISEVALTEXT GETDATAVALUEGETPROXYOBJECT GETPROXYCODEMESSAGE$%C N  %C OYB-}CC  U ODATAOBJECTEFORMAT ODROPTARGET NMOUSEXPOS NMOUSEYPOSSETDATATHIS GETPROXYCODEE"Cclasslib-#C classname-#C baseclass-%C parentclass-Cid-8CtemplateTemplate- cfoxeditbox0CwsdlWSDL- cfoxtextbox.CuriURI- cfoxtextbox6CserviceService- cfoxtextbox0CportPort- cfoxtextbox0CwsmlWSML- cfoxtextbox2CclassClass- cfoxtextbox%T=C objectname Object name- cfoxtextbox$C objectname-%@C properties Properties-cfoxpropertybox$C properties->C runbuilderBuilder-cfoxbuildercomboUTHIS ADDDATAVALUELSHOWOBJECTNAMELSHOWPROPERTIESo *T CCCclasslib +T CCC classname ,T CCC objectname ,T CCC properties %C /%T CQffc\_ws3client.vcxT %C \T  wshandlerT C9wsdl=<>C :port=<>C @service=<>C =wsname=<>C webserviceid=<>C :wsml=<>-<<>>C  )T CC runbuilder @C        BU ODROPTARGETCSCXNAMENXPOSNYPOSCOBJNAME CPROPERTYLIST CCLASSNAME CCLASSLIBCORIGINALOBJNAMECNEWPROPERTYLISTTHISEVALTEXT GETDATAVALUE RUNBUILDER DROPOBJECTCU OCONTEXTMENUTHISCREATEFORMMENU getproxycode, onolesetdataoncreatedatavaluesdroponcontainercreatecontextmenu7 1rqqqqqqqqqqq1AaQaA1qA!A!AA5rBqqAA4#11Qa!AAAA34qqqqqqQAAB8r2,P:5yd HM 8id`)M *%>!/UT CT C %C OC  BU OTOOLCOLLECTION CUNIQUEIDOUNIQUECOLLECTION OTOOLITEMTHISOENGINEGETTOOLSINCATEGORYUNIQUEID GETTOOLOBJECTADD- C!CtoptoolaUTHIS ADDDATAVALUEd T "T CShowType %C  T  % T '%C LockDelete yT #T C 6%C NR+T C B U ODATAOBJECTNEFFECTNBUTTONNSHIFTNXCOORDNYCOORDNSTATE CSHOWTYPE NNEWEFFECTTHIS GETDRAGDATALOCKADD5%CO.CUTHISOENGINE CUSTOMIZEUNIQUEID CTCUTHISSHOWTYPEBCUTHISOENGINESHOWCATEGORYPROPERTIESFORMonrendercategory,oncreatedatavaluesI ondragover customizejInitonshowproperties1sqqqqQAAB33qq#q2AAArA3aA33C4gz&>*MD-tK) H%I7UT!T CCfolder%C MC UCFOLDERTHIS GETDATAVALUESHELLTO2(C\>] + CHR(10), ; .F., "<<", ">>") + ; CHR(10) + THIS.EvalText(NVL(THIS.GetDataValue("properties"), '')) THIS.DropObject(m.oDropTarget, m.cSCXName, m.nXPos, m.nYPos, "Image", '', "Image", m.cOriginalObjName, m.cPropertyList, '', '') RETURN ENDPROC PROCEDURE imagefile_access LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF UPPER(JUSTEXT(m.cFilename)) == "BMP" AND FILE(m.cFilename) RETURN m.cFilename ELSE RETURN '' ENDIF ENDPROC PROCEDURE openitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) THIS.ShellTo(m.cFilename) ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_OPEN_LOC, [oRef.OpenItem()]) THIS.CreateFormMenu(m.oContextMenu) ENDPROC PROCEDURE oncompletedrag LPARAMETERS nEffect, oDropTarget, nMouseXPos, nMouseYPos THIS.DropOnContainer(m.oDropTarget, '', m.nMouseXPos, m.nMouseYPos) RETURN ENDPROC PROCEDURE onolesetdata LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos THIS.SetDataValue("classname", "Image") DODEFAULT(oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos) ENDPROC imagefile oengine Reference to Toolbox engine. odatacollection uniqueid parentid toolname tooltip filename displayord user internal tooltype tooldata classlib classname classtype setid tooltypeid showtype showaslink ndatasessionid ltooldataparsed helpfile lockadd lockdelete lockrename isvirtual inactive helpid runbuilder Y - always run builder, N - never run builder, blank to respect builder lock setting *onrightclick *oncompletedrag *ondragdrop *ondragstart *ondragover *renameitem *deleteitem *newtool *onstartdrag *onclick *getdragdata *ondraggivefeedback *modifyitem *createmenu *addcategory *togglehelptext *togglealwaysontop *customize *evaltext *onolesetdata *adddatavalue *getdatavalue *setdatavalue *onshowproperties *properties *imagefile_access *shellto *createcontextmenu Create context-specific menu items. *pushds *popds *dropobject Create an object on the drop target. *parsetooldata *oncreatedatavalues *encodetooldata *getimagefile *gethelpfile Allows for dynamic setting of the help file. *oncreate Called when item is created from the Customize toolbox dialog. *onkeypress *tooldata_access *tooldata_assign *getopenforms *ondblclick *invokeaddin *parsepropertylist *getuniqueobjname *addclasslib *addtofavorites *showhelp *getregistryvalue *addtodataenv *createaddinsmenu >PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY EDITSOURCE(m.cFilename) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC PROCEDURE runitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) TRY DO (m.cFilename) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) oContextMenu.Addmenu(TOOLMENU_RUN_LOC, [oRef.RunItem()]) ENDPROC   %V1UV#T CCfilename%C OC U CFILENAMETHIS GETDATAVALUESHELLTO5% C. CUTHISALLOWDROPONCONTAINER MODIFYITEM C=Cfilename File name- cfoxfilenameTC CollectionN(CEDITSOURCE(#filename#)H*CEDITSOURCE(#filename#)TXT*CEDITSOURCE(#filename#)LOGUTHIS ADDDATAVALUEOMODIFYCOLLECTIONADD#T CCfilename%C }T CC fT %C T C  (T %C C  y/T C  #filename#" "MC  (uC 0ToolboxxU CFILENAMECEXT OEXCEPTION CSCRIPTCODETHIS GETDATAVALUEOMODIFYCOLLECTIONGETKEYITEMSHELLTOMESSAGE$% CUTHIS SHOWASLINK ONDBLCLICK#T CCfilename%C  T CC f%C 0TC\> (C   U ODATAOBJECTEFORMAT ODROPTARGET NMOUSEXPOS NMOUSEYPOSCTEXT OEXCEPTIONTHIS CLASSBEHAVIOR GETDATAVALUEDROPTEXTTEMPLATESETDATAopenitem, ondblclickoncreatedatavalues modifyitem5onclick.createcontextmenut onolesetdata1t2!1A3A4A4tqqq2!aAA1AAA2A4rqqq2!aAA4rqqQ21AAAA25 ^(1L5BSD1 h)  PROCEDURE browseitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) THIS.PushDS() TRY IF !USED(JUSTSTEM(m.cFilename)) USE (m.cFilename) IN 0 SHARED AGAIN ENDIF SELECT (JUSTSTEM(m.cFilename)) BROWSE NORMAL NOWAIT CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY THIS.PopDS() ENDIF ENDPROC PROCEDURE ondblclick LOCAL oWindowCollection LOCAL lBrowse m.lBrowse = .T. IF THIS.AllowDropOnContainer m.oWindowCollection = THIS.GetOpenForms() m.lBrowse = (m.oWindowCollection.Count == 0) m.oWindowCollection = .NULL. ENDIF IF m.lBrowse THIS.BrowseItem() ELSE DODEFAULT() ENDIF ENDPROC PROCEDURE droponcontainer #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDropTarget, cSCXName, nXPos, nYPos LOCAL cClassLib LOCAL cClassName LOCAL cPropertyList LOCAL cOriginalObjName LOCAL cFilename m.cClassLib = THIS.GetRegistryValue("ClassLocation", INTELLIDROP_KEY + "Multiple") m.cClassName = THIS.GetRegistryValue("ClassName", INTELLIDROP_KEY + "Multiple") m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF EMPTY(m.cClassName) OR !FILE(m.cClassLib) m.cClassLib = '' m.cClassName = "Grid" ENDIF m.cOriginalObjName = NVL(THIS.GetDataValue("objectname"), '') IF EMPTY(m.cOriginalObjName) m.cOriginalObjName = "grd" + JUSTSTEM(m.cFilename) ENDIF m.cPropertyList = TEXTMERGE( ; [RecordSourceType=1] + CHR(10) + ; [RecordSource=<>] + CHR(10), ; .F., "<<", ">>") + ; CHR(10) + THIS.EvalText(NVL(THIS.GetDataValue("properties"), '')) THIS.DropObject(m.oDropTarget, m.cSCXName, m.nXPos, m.nYPos, m.cClassName, m.cClassLib, '', cOriginalObjName, m.cPropertyList, '', '', m.cFilename) ENDPROC PROCEDURE modifyitem #include "foxpro.h" #include "toolbox.h" LOCAL m.cFilename m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) THIS.PushDS() TRY IF !USED(JUSTSTEM(m.cFilename)) USE (m.cFilename) IN 0 SHARED AGAIN ENDIF SELECT (JUSTSTEM(m.cFilename)) MODIFY STRUCTURE CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY THIS.PopDS() ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_BROWSE_LOC, [oRef.BrowseItem()]) oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) oContextMenu.Addmenu(TOOLMENU_OPEN_LOC, [oRef.OpenItem()]) THIS.CreateFormMenu(m.oContextMenu) ENDPROC PROCEDURE openitem #include "foxpro.h" #include "toolbox.h" LOCAL cFilename LOCAL nDataSessionID m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) THIS.PushDS() TRY IF !USED(JUSTSTEM(m.cFilename)) USE (m.cFilename) IN 0 SHARED AGAIN ENDIF SELECT (JUSTSTEM(m.cFilename)) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY THIS.PopDS() ENDIF ENDPROC PROCEDURE oncompletedrag LPARAMETERS nEffect, oDropTarget, nMouseXPos, nMouseYPos THIS.DropOnContainer(m.oDropTarget, '', m.nMouseXPos, m.nMouseYPos) RETURN ENDPROC  b I I 7%L ] U #T CCfilename%C  C%CC ֪ {Q FC  : (C 0Toolboxx CU CFILENAMETHIS GETDATAVALUEPUSHDS OEXCEPTIONMESSAGEPOPDS T a%dT CT   T %  C CUOWINDOWCOLLECTIONLBROWSETHISALLOWDROPONCONTAINER GETOPENFORMSCOUNT BROWSEITEM|T C ClassLocation Software\Microsoft\VisualFoxPro\C  \Options\IntelliDrop\FieldTypes\Multiple xT C ClassName Software\Microsoft\VisualFoxPro\C  \Options\IntelliDrop\FieldTypes\Multiple #T CCfilename %C  C 0 T T Grid%T CC objectname %C T grdC T CRecordSourceType=1C &RecordSource=<>C -<<>>C CCC properties JC        U ODROPTARGETCSCXNAMENXPOSNYPOS CCLASSLIB CCLASSNAME CPROPERTYLISTCORIGINALOBJNAME CFILENAMETHISGETREGISTRYVALUEVERSION GETDATAVALUEEVALTEXT DROPOBJECT #T CCfilename%C  C%CC ֪ {Q FC / (C 0Toolboxx CU CFILENAMETHIS GETDATAVALUEPUSHDS OEXCEPTIONMESSAGEPOPDS,CBro\ 0 WITH _VFP.ActiveProject m.nCnt = .Files.Count FOR m.i = 1 TO m.nCnt IF _VFP.ActiveProject.Files(m.i).Type == 'V' m.nClassCnt = AVCXCLASSES(aVCXInfo, _VFP.ActiveProject.Files(m.i).Name) FOR m.j = 1 TO m.nClassCnt m.cToolTip = aVCXInfo[m.j, 8] && class description m.cImageFile = THIS.oEngine.GetImageForClass(aVCXInfo[m.j, 2]) oToolObject = THIS.oEngine.GetVirtualToolObject("CLASS", THIS.oEngine.GenerateToolName(_VFP.ActiveProject.Files(m.i).Name, aVCXInfo[m.j, 1]), '') IF VARTYPE(oToolObject) == 'O' oToolObject.SetDataValue("classlib", _VFP.ActiveProject.Files(m.i).Name) oToolObject.SetDataValue("classname", aVCXInfo[m.j, 1]) oToolObject.SetDataValue("objectname", aVCXInfo[m.j, 1]) oToolObject.SetDataValue("parentclass", aVCXInfo[m.j, 3]) oToolObject.SetDataValue("baseclass", aVCXInfo[m.j, 2]) * m.oToolObject.SetDataValue("filename", m.cFolder + aFileList[m.j, 1]) THIS.oEngine.SaveVirtual(m.oToolObject) m.oToolCollection.Add(m.oToolObject) ENDIF ENDFOR ENDIF ENDFOR ENDWITH ENDIF RETURN ENDPROC PROCEDURE customize IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.Customize(THIS.ParentID) ENDIF ENDPROC PROCEDURE ondragover #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState LOCAL cShowType LOCAL nNewEffect LOCAL lLockDelete LOCAL cParentID m.nNewEffect = DODEFAULT(oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState) IF VARTYPE(m.nNewEffect) <> 'N' * if our source is a button, then we handle internally m.cShowType = THIS.GetDragData(oDataObject, "ShowType") m.cParentID = THIS.GetDragData(oDataObject, "ParentID") m.lLockDelete = (THIS.GetDragData(oDataObject, "LockDelete") == 'y') IF !ISNULL(m.cShowType) AND m.cShowType == SHOWTYPE_TOOL IF m.lLockDelete m.nNewEffect = IIF(m.cParentID == THIS.ParentID, DROPEFFECT_MOVE, DROPEFFECT_COPY) ELSE m.nNewEffect = IIF(m.nShift == 2, DROPEFFECT_COPY, DROPEFFECT_MOVE) ENDIF ENDIF ENDIF RETURN m.nNewEffect ENDPROC PROCEDURE Init #include "toolbox.h" DODEFAULT() THIS.ShowType = SHOWTYPE_TOOL ENDPROC PROCEDURE onshowproperties * -- show the properties dialog RETURN THIS.oEngine.ShowPropertiesForm(THIS) ENDPROC EPROCEDURE oncreatedatavalues #include "toolbox.h" DODEFAULT() THIS.AddDataValue("refresh", .F., DATAVALUE_REFRESHCATEGORY_LOC, '', .F., "cfoxcheckbox", '') ENDPROC PROCEDURE ondblclick IF !THIS.ShowAsLink THIS.RunItem() ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu LOCAL oMenuBar oMenuBar = oContextMenu.Addmenu(TOOLMENU_RUN_LOC, [oRef.RunItem()]) oMenuBar.Bold = .T. ENDPROC PROCEDURE runitem #include "foxpro.h" #include "toolbox.h" LOCAL cFilename LOCAL lRefresh LOCAL oException m.cFilename = NVL(THIS.GetDataValue("filename"), '') m.lRefresh = NVL(THIS.GetDataValue("refresh"), .F.) IF VARTYPE(m.lRefresh) <> 'L' m.lRefresh = .F. ENDIF IF !EMPTY(m.cFilename) * if filename to run is surrounded by parens, then execute as a macro IF LEFT(m.cFilename, 1) == '(' AND RIGHT(m.cFilename, 1) == ')' m.cFilename = SUBSTR(LEFT(m.cFilename, LEN(m.cFilename) - 1), 2) TRY &cFilename CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ELSE TRY DO (m.cFilename) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF IF m.lRefresh THIS.oEngine.LoadToolbox() ENDIF ENDIF ENDPROC PROCEDURE onclick THIS.RunItem() ENDPROC 0 e %.U&untitledC]:Uy+T CCC baseclassJOQ : (rC0ToolboxxU CBASECLASSTHISEVALTEXT GETDATAVALUE OEXCEPTIONMESSAGE+T CCC baseclass ,T CCC objectname ,T CCC properties )T CC runbuilder  @C        BU ODROPTARGETCSCXNAMENXPOSNYPOS CBASECLASSCOBJNAME CPROPERTYLISTTHISEVALTEXT GETDATAVALUE RUNBUILDER DROPOBJECT)  TTC% @C oRef.DropOnContainer(.NULL., " ")%COTCAdd \C runbuilderBuilder-cfoxbuildercomboUTHIS ADDDATAVALUE<"C   BUNEFFECT ODROPTARGET NMOUSEXPOS NMOUSEYPOSTHISDROPONCONTAINER     5%C N  C O +T CCC baseclassT  T ,T CCC objectname,T CCC properties%C VT oT  T | GetKeyStateuser32T CCV GetKeyState% T C"%C CC T  DEFINE CLASS  AS  C C C C C C PROCEDURE InitC C C C C ENDPROCC C C C C PROCEDURE DestroyC C C C C ENDPROCC C C C C 'PROCEDURE Error(nError, cMethod, nLine)C C C C C ENDPROCC C C C  ENDDEFINET C"%C CC 2T   = CREATEOBJECT(" ")%C T CWFoT C a<<>> ( T   F C  U ODATAOBJECTEFORMAT ODROPTARGET NMOUSEXPOS NMOUSEYPOSCLASSLIB CLASSNAME OBJECTNAMEOBJNAME BASECLASS PROPERTYLIST CDROPTEXTNSELECT OEXCEPTIONLCTRLKEYPRESSEDTHISEVALTEXT GETDATAVALUE GETKEYSTATEUSER32OENGINE CTRLDROPTEXTGETPROPERTYSETDROPTEXTMESSAGESETDATA&T CCC baseclass@:%C  exceptioncolumnheadersession 9CCreate \>C -<<>>C CCC properties JC   ImageImage   BU ODROPTARGETCSCXNAMENXPOSNYPOS CPROPERTYLIST CFILENAMECORIGINALOBJNAMETHIS GETDATAVALUEEVALTEXT DROPOBJECTu #T CCfilename&%CC fBMPC 0 ] B n BU CFILENAMETHIS GETDATAVALUEX #T CCfilename%C QC U CFILENAMETHIS GETDATAVALUESHELLTOE(C\ 'O' OR ISNULL(_oobjectbrowser) DO (_objectbrowser) ENDIF IF TYPE("_oobjectbrowser") == 'O' AND !ISNULL(_oobjectbrowser) TRY _oobjectbrowser.LoadTypeLib(m.cFilename) CATCH ENDTRY ENDIF ENDIF ENDPROC PROCEDURE gethelpfile * Check the type library for help file LOCAL oTypeLib LOCAL oFileInfo LOCAL cHelpFile LOCAL cFilename m.cHelpFile = '' m.cFilename = NVL(THIS.GetDataValue("classlib"), '') IF !EMPTY(m.cFilename) TRY m.oTypeLib = CREATEOBJECT("tli.tliapplication") m.oFileInfo = m.oTypeLib.TypeLibInfoFromFile(m.cFilename) m.cHelpFile = STRTRAN(m.oFileInfo.HelpFile, CHR(0), '') CATCH ENDTRY m.oTypeLib = .NULL. m.oFileInfo = .NULL. IF EMPTY(m.cHelpFile) OR !FILE(m.cHelpFile) m.cHelpFile = '' ENDIF ENDIF RETURN m.cHelpFile ENDPROC PROCEDURE oncreatedatavalues #include "toolbox.h" THIS.AddDataValue("classlib", '', DATAVALUE_CLASSLIBRARY_LOC, '', .T., "cfoxtextbox") THIS.AddDataValue("classname", '', DATAVALUE_CLASSNAME_LOC, '', .T., "cfoxtextbox") THIS.AddDataValue("comcontrol", '', '', '', .T.) THIS.AddDataValue("objectname", '', DATAVALUE_OBJECTNAME_LOC, '', .F., "cfoxtextbox") IF THIS.lShowProperties THIS.AddDataValue("properties", '', DATAVALUE_PROPERTIES_LOC, '', .F., "cfoxpropertybox") ELSE THIS.AddDataValue("properties", '', '', '', .F.) ENDIF ENDPROC PROCEDURE onolesetdata #include "foxpro.h" #define VK_CONTROL 0x11 #define CRLF CHR(13) + CHR(10) #define TAB CHR(9) LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos LOCAL ClassName LOCAL ObjectName LOCAL BaseClass LOCAL cDropText LOCAL nSelect LOCAL oException IF VARTYPE(m.eFormat) == 'N' AND m.eFormat == CF_TEXT IF VARTYPE(m.oDropTarget) == 'O' RETURN .F. ELSE * we're not dropping on an object container, so assume * we're dropping text -- create the code to instantiate the object m.ClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) IF !EMPTY(m.ClassName) m.BaseClass = THIS.EvalText(NVL(THIS.GetDataValue("baseclass"), '')) m.ObjectName = THIS.EvalText(NVL(THIS.GetDataValue("objectname"), '')) IF EMPTY(m.ObjectName) m.ObjectName = 'o' ENDIF m.cDropText = '' DECLARE INTEGER GetKeyState IN user32 INTEGER vKey IF BITTEST(GetKeyState(VK_CONTROL), 15) m.cDropText = THIS.EvalText(THIS.oEngine.CtrlDropText) IF VARTYPE(m.cDropText) <> 'C' OR EMPTY(m.cDropText) m.cDropText = ; [DEFINE CLASS My] + CHRTRAN(m.ClassName, '.', '_') + [ AS ] + m.ClassName + CRLF + CRLF + ; TAB + [PROCEDURE Init] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; TAB + [PROCEDURE Destroy] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; TAB + [PROCEDURE Error(nError, cMethod, nLine)] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; [ENDDEFINE] ENDIF ELSE m.cDropText = THIS.EvalText(THIS.oEngine.DropText) IF VARTYPE(m.cDropText) <> 'C' OR EMPTY(m.cDropText) m.cDropText = m.ObjectName + [ = CREATEOBJECT("] + m.ClassName + [")] ENDIF ENDIF CLEAR DLLS "GetKeyState" IF !EMPTY(m.cDropText) m.nSelect = SELECT() SELECT 0 && make sure we won't end up evaluating a field from a table TRY m.cDropText = TEXTMERGE(m.cDropText, .T., "<<", ">>") CATCH TO oException m.cDropText = oException.Message ENDTRY SELECT (m.nSelect) ENDIF m.oDataObject.SetData(m.cDropText, m.eFormat) ENDIF ENDIF ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oMenuBar = oContextMenu.Addmenu(TOOLMENU_OPENOBJECTBROWSER_LOC, [oRef.OpenItem()]) THIS.CreateFormMenu(oContextMenu) ENDPROC DPROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu oContextMenu.Addmenu(TOOLMENU_OPEN_LOC, [oRef.OpenItem()]) ENDPROC PROCEDURE onrendercategory * load the passed collection with the registered * ActiveX controls #include "toolbox.h" LPARAMETERS oToolCollection LOCAL oToolObject LOCAL cFolder LOCAL nCnt LOCAL i LOCAL oToolType LOCAL cDirectory LOCAL nControlCnt LOCAL ARRAY aFileList[1] LOCAL oReg,i,cOptPath,nPos,nTotDone,cVFPKey,cExtn,oTForm,lnPos LOCAL aCLSIDs,aKeys,aProgID,aControlName,aServerName,cScanKey,iCount,lcServerName DODEFAULT(m.oToolCollection) cOptPath = CLSID_KEY+"\" IF VARTYPE(m.lAllControls)#"L" m.lAllControls = .F. ENDIF IF VARTYPE(m.cActiveXFile)#"C" m.cActiveXFile = "" ENDIF cExtn = UPPER(JUSTEXT(m.cActiveXFile)) m.cVFPKey = VFP_OPTIONS_KEY + _VFP.Version + VFP_OPTIONS_KEY2 cHKEY = IIF(m.lAllControls, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER) cActiveXKey = IIF(m.lAllControls, CLSID_KEY, m.cVFPKey) DIMENSION aCLSIDs[1] DIMENSION aControls[1,3] STORE "" TO aControls,aCLSIDs TRY oReg = NEWOBJECT("registry", "toolboxregistry.vcx", _TOOLBOX) CATCH ENDTRY IF VARTYPE(oReg)#"O" RETURN .F. ENDIF IF EMPTY(aCLSIDs[1]) IF oReg.EnumOptions(@aCLSIDs,m.cActiveXKey,m.cHKey,.T.)#0 RETURN .F. ENDIF ENDIF nControlCnt = 0 FOR i = 1 TO ALEN(aCLSIDs) DIMENSION aKeys[1] DIMENSION aProgID[1,2] DIMENSION aServerName[1,2] DIMENSION aControlName[1,2] STORE "" TO aProgID,aControlName,aServerName,aKeys IF oReg.EnumOptions(@aKeys,m.cOptPath + aCLSIDs[m.i], '', .T.) == 0 DO CASE CASE m.cExtn="DLL" cScanKey=INPROC_KEY CASE m.cExtn="EXE" cScanKey=LOCALSVR_KEY OTHERWISE cScanKey=CONTROL_KEY ENDCASE nPos = ASCAN(aKeys,m.cScanKey) IF m.nPos = 0 LOOP ENDIF oReg.EnumOptions(@aServerName,cOptPath+aCLSIDs[m.i]+"\"+IIF(m.cExtn="EXE",LOCALSVR_KEY,INPROC_KEY)) * Need to normalize servername to remove extraneous command switches such as * /automation, etc. IF !FILE(aServerName[2]) lnPOS = RATC(" /",aServerName[2]) IF lnPos>0 aServerName[2]= ALLTRIM(SUBSTRC(aServerName[2],1,lnPos-1)) ENDIF lnPOS = RATC(" -",aServerName[2]) IF lnPos>0 aServerName[2]= ALLTRIM(SUBSTRC(aServerName[2],1,lnPos-1)) ENDIF * Check to see if still not right file IF !FILE(aServerName[2]) IF TYPE("aServerName[4]")="C" AND FILE(aServerName[4]) aServerName[2] = aServerName[4] ELSE * SKIP control LOOP ENDIF ENDIF ENDIF IF EMPTY(m.cActiveXFile) OR ; JUSTFNAME(UPPER(aServerName[2]))==JUSTFNAME(UPPER(m.cActiveXFile)) oReg.EnumOptions(@aControlName,cOptPath+aCLSIDs[m.i]) oReg.EnumOptions(@aProgID,cOptPath+aCLSIDs[m.i]+PROGID_KEY) IF !EMPTY(aControls[1,1]) DIMENSION aControls[ALEN(aControls,1)+1,3] ENDIF nControlCnt = nControlCnt + 1 aControls[ALEN(aControls,1),1] = aControlName[2] aControls[ALEN(aControls,1),2] = aProgID[2] aControls[ALEN(aControls,1),3] = aServerName[2] ENDIF ENDIF ENDFOR FOR m.i = 1 TO m.nControlCnt m.oToolObject = THIS.oEngine.GetVirtualToolObject("ACTIVEX", aControls[m.i, 1]) IF !ISNULL(m.oToolObject) m.oToolObject.SetDataValue("classlib", aControls[m.i, 3]) m.oToolObject.SetDataValue("classname", aControls[m.i, 2]) m.oToolObject.SetDataValue("comcontrol", .T.) m.oToolObject.SetDataValue("objectname", "Olecontrol") m.oToolObject.SetDataValue("properties", '') THIS.oEngine.SaveVirtual(m.oToolObject) m.oToolCollection.Add(m.oToolObject) ENDIF ENDFOR RETURN ENDPROC   %[' UT C textscrap%C #T C evaltextmerge%C L T -% T C a<<>>T UCSCRAP LTEXTMERGETHIS GETDATAVALUET<CC\ -1 TRY m.cScriptCode = THIS.oModifyCollection.Item(m.cExt) CATCH TO oException m.cScriptCode = '' ENDTRY ENDIF IF EMPTY(m.cScriptCode) THIS.ShellTo(m.cFilename) ELSE m.cScriptCode = STRTRAN(m.cScriptCode, "#filename#", ["] + m.cFilename + ["]) TRY EXECSCRIPT(m.cScriptCode) CATCH TO oException MESSAGEBOX(oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF ENDIF ENDPROC PROCEDURE onclick IF THIS.ShowAsLink THIS.OnDblClick() ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu LOCAL cFilename LOCAL cExt LOCAL oMenuBar m.cFilename = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(m.cFilename) m.cExt = UPPER(JUSTEXT(m.cFilename)) IF THIS.oModifyCollection.GetKey(m.cExt) <> -1 oMenuBar = oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) ELSE oMenuBar = oContextMenu.Addmenu(TOOLMENU_OPEN_LOC, [oRef.OpenItem()]) ENDIF oMenuBar.Bold = .T. ENDIF ENDPROC PROCEDURE onolesetdata #include "foxpro.h" LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos LOCAL cText LOCAL oException IF THIS.ClassBehavior DODEFAULT(oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos) ELSE IF VARTYPE(m.eFormat) == 'N' AND m.eFormat == CF_TEXT AND VARTYPE(m.oDropTarget) <> 'O' * evaluate the Drop Text Template m.cText = NVL(THIS.GetDataValue("filename"), '') IF !EMPTY(THIS.DropTextTemplate) TRY m.cText = TEXTMERGE(THIS.DropTextTemplate, .F., "<<", ">>") CATCH TO oException ENDTRY ENDIF m.oDataObject.SetData(m.cText, m.eFormat) ENDIF ENDIF ENDPROC EPROCEDURE oncreatedatavalues #include "toolbox.h" IF THIS.lShowClassInfo THIS.AddDataValue("classlib", '', DATAVALUE_CLASSLIBRARY_LOC, '', .F., "cfoxclassinfo", '', "cClassLib") THIS.AddDataValue("classname", '', '', '', .F., '', '', "cClassName") THIS.AddDataValue("baseclass", '', DATAVALUE_BASECLASS_LOC, '', .F., '', '', "cBaseClass") THIS.AddDataValue("parentclass", '', '', '', .F., '', '', "cParentClass") ELSE THIS.AddDataValue("classlib", '', '', '', .F.) THIS.AddDataValue("classname", '', '', '', .F.) THIS.AddDataValue("baseclass", '', '', '', .F.) THIS.AddDataValue("parentclass", '', '', '', .F.) ENDIF IF THIS.lShowObjectName THIS.AddDataValue("objectname", '', DATAVALUE_OBJECTNAME_LOC, '', .F., "cfoxtextbox") ELSE THIS.AddDataValue("objectname", '', '', '', .F.) ENDIF IF THIS.lShowProperties THIS.AddDataValue("properties", '', DATAVALUE_PROPERTIES_LOC, '', .F., "cfoxpropertybox") ELSE THIS.AddDataValue("properties", '', '', '', .F.) ENDIF THIS.AddDataValue("runbuilder", '', DATAVALUE_BUILDER_LOC, '', .F., "cfoxbuildercombo") ENDPROC PROCEDURE onolesetdata #include "foxpro.h" #define VK_CONTROL 0x11 #define CRLF CHR(13) + CHR(10) #define TAB CHR(9) LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos LOCAL ClassLib LOCAL ClassName LOCAL ObjectName LOCAL ObjName LOCAL BaseClass LOCAL cDropText LOCAL nSelect LOCAL oException LOCAL PropertyList LOCAL lCtrlKeyPressed IF VARTYPE(m.eFormat) == 'N' AND m.eFormat == CF_TEXT IF VARTYPE(m.oDropTarget) == 'O' && AND INLIST(m.oDropTarget.BaseClass, "Form", "Formset", "Page", "Container", "Column", "Toolbar") RETURN .F. ELSE DECLARE INTEGER GetKeyState IN user32 INTEGER vKey m.lCtrlKeyPressed = BITTEST(GetKeyState(VK_CONTROL), 15) CLEAR DLLS "GetKeyState" * we're not dropping on an object container, so assume * we're dropping text -- create the code to instantiate the object m.ClassLib = THIS.EvalText(NVL(THIS.GetDataValue("classlib"), '')) m.ClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) IF !EMPTY(m.ClassName) OR !EMPTY(m.ClassLib) m.BaseClass = THIS.EvalText(NVL(THIS.GetDataValue("baseclass"), '')) m.ObjectName = THIS.EvalText(NVL(THIS.GetDataValue("objectname"), '')) IF EMPTY(m.ObjectName) m.ObjectName = 'o' ENDIF m.ObjName = m.ObjectName * get properties m.PropertyList = THIS.EvalText(NVL(THIS.GetDataValue("properties"), '')) m.cDropText = '' IF m.lCtrlKeyPressed m.cDropText = THIS.EvalText(THIS.oEngine.CtrlDropText) IF VARTYPE(m.cDropText) <> 'C' OR EMPTY(m.cDropText) m.cDropText = ; [DEFINE CLASS My] + m.ClassName + [ AS ] + m.ClassName + [ OF ] + JUSTFNAME(m.ClassLib) + CRLF + ; THIS.GetPropertySet(m.PropertyList) + CRLF + ; TAB + [PROCEDURE Init] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; TAB + [PROCEDURE Destroy] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; TAB + [PROCEDURE Error(nError, cMethod, nLine)] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; [ENDDEFINE] ENDIF ELSE m.cDropText = THIS.EvalText(THIS.oEngine.DropText) IF VARTYPE(m.cDropText) <> 'C' OR EMPTY(m.cDropText) IF EMPTY(m.ClassLib) m.cDropText = m.ObjectName + [ = CREATEOBJECT("] + m.ClassName + [")] ELSE m.cDropText = m.ObjectName + [ = NEWOBJECT("] + m.ClassName + [", "] + JUSTFNAME(m.ClassLib) + [")] ENDIF ENDIF ENDIF IF !EMPTY(m.cDropText) m.nSelect = SELECT() SELECT 0 && make sure we won't end up evaluating a field from a table TRY m.cDropText = TEXTMERGE(m.cDropText, .T., "<<", ">>") CATCH TO oException m.cDropText = oException.Message ENDTRY SELECT (m.nSelect) ENDIF m.oDataObject.SetData(m.cDropText, m.eFormat) ENDIF ENDIF ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu LOCAL oMenuBar oMenuBar = oContextMenu.Addmenu(TOOLMENU_MODIFY_LOC, [oRef.ModifyItem()]) IF LOWER(JUSTEXT(NVL(THIS.GetDataValue("classlib"), ''))) == "vcx" oContextMenu.Addmenu(TOOLMENU_CREATESUBCLASS_LOC, [oRef.CreateSubclass()]) ENDIF IF LOWER(NVL(THIS.GetDataValue("baseclass"), '')) == "form" oContextMenu.Addmenu(TOOLMENU_CREATEFORM_LOC, [oRef.CreateForm()]) ENDIF THIS.CreateFormMenu(oContextMenu) ENDPROC PROCEDURE modifyitem LOCAL cClassLib LOCAL cClassName m.cClassLib = THIS.EvalText(NVL(THIS.GetDataValue("classlib"), '')) m.cClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) IF FILE(m.cClassLib) TRY EDITSOURCE(m.cClassLib, 0, m.cClassName) CATCH ENDTRY ENDIF ENDPROC PROCEDURE oncompletedrag #include "foxpro.h" #include "toolbox.h" LPARAMETERS nEffect, oDropTarget, nMouseXPos, nMouseYPos THIS.DropOnContainer(m.oDropTarget, '', m.nMouseXPos, m.nMouseYPos) RETURN ENDPROC PROCEDURE createform * create a form from the form class #include "foxpro.h" #include "toolbox.h" LOCAL cClassLib LOCAL cClassName LOCAL oException m.cClassLib = THIS.EvalText(NVL(THIS.GetDataValue("classlib"), '')) m.cClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) TRY * using "untitled" + SYS(3) forces VFP to not re-use any existing untitled windows * (don't ask me why it works, but it does!) CREATE FORM "untitled" + SYS(3) AS (m.cClassName) FROM (m.cClassLib) NOWAIT CATCH TO oException MESSAGEBOX(oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDPROC PROCEDURE createsubclass * create a subclass #include "foxpro.h" #include "toolbox.h" LOCAL cClassLib LOCAL cClassName LOCAL oException m.cClassLib = THIS.EvalText(NVL(THIS.GetDataValue("classlib"), '')) m.cClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) TRY CREATE CLASS ? OF (m.cClassLib) AS (m.cClassName) FROM (m.cClassLib) NOWAIT CATCH TO oException MESSAGEBOX(oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDPROC PROCEDURE droponcontainer * Drop a class on the current container #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDropTarget, cSCXName, nXPos, nYPos LOCAL cObjName LOCAL cPropertyList LOCAL cClassName LOCAL cClassLib LOCAL cOriginalObjName LOCAL cBaseClass LOCAL cContainerClassLib LOCAL cContainerClassName m.cBaseClass = THIS.EvalText(NVL(THIS.GetDataValue("baseclass"), '')) m.cClassLib = THIS.EvalText(NVL(THIS.GetDataValue("classlib"), '')) m.cClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) m.cOriginalObjName = THIS.EvalText(NVL(THIS.GetDataValue("objectname"), '')) m.cPropertyList = THIS.EvalText(NVL(THIS.GetDataValue("properties"), '')) m.cContainerClassLib = THIS.EvalText(NVL(THIS.GetDataValue("containerclasslib"), '')) m.cContainerClassName = THIS.EvalText(NVL(THIS.GetDataValue("containerclassname"), '')) THIS.RunBuilder = NVL(THIS.GetDataValue("runbuilder"), THIS.RunBuilder) THIS.DropObject(m.oDropTarget, m.cSCXName, m.nXPos, m.nYPos, m.cClassName, m.cClassLib, m.cBaseClass, m.cOriginalObjName, m.cPropertyList, m.cContainerClassName, m.cContainerClassLib) RETURN ENDPROC   %U%NCclasslib Class library- cfoxclassinfo cClassLib6C classname- cClassName@C baseclass Base class- cBaseClass:C parentclass- cParentClass"Cclasslib-#C classname-#C baseclass-%C parentclass-%=C objectname Object name- cfoxtextbox $C objectname-%t@C properties Properties-cfoxpropertybox$C properties->C runbuilderBuilder-cfoxbuildercomboUTHISLSHOWCLASSINFO ADDDATAVALUELSHOWOBJECTNAMELSHOWPROPERTIES     $%C N  %C OB-| GetKeyStateuser32T CCV GetKeyState*T CCCclasslib+T CCC classname%C  C  +T CCC baseclass,T CCC objectname%C T oT  ,T CCC propertiesT % T C"%C CC T DEFINE CLASS My  AS   OF C C C C C C C PROCEDURE InitC C C C C ENDPROCC C C C C PROCEDURE DestroyC C C C C ENDPROCC C C C C 'PROCEDURE Error(nError, cMethod, nLine)C C C C C ENDPROCC C C C  ENDDEFINET C"%C CC %C 2T   = CREATEOBJECT(" ")@T   = NEWOBJECT(" ", "C ")%C uT CWFGT C a<<>> ( eT   F C  U ODATAOBJECTEFORMAT ODROPTARGET NMOUSEXPOS NMOUSEYPOSCLASSLIB CLASSNAME OBJECTNAMEOBJNAME BASECLASS CDROPTEXTNSELECT OEXCEPTION PROPERTYLISTLCTRLKEYPRESSED GETKEYSTATEUSER32THISEVALTEXT GETDATAVALUEOENGINE CTRLDROPTEXTGETPROPERTYSETDROPTEXTMESSAGESETDATA0TC\> ( ST   F C   U ODATAOBJECTEFORMAT ODROPTARGET NMOUSEXPOS NMOUSEYPOS CLASSNAME OBJECTNAME BASECLASS CDROPTEXTNSELECT OEXCEPTIONTHISEVALTEXT GETDATAVALUE GETKEYSTATEUSER32OENGINE CTRLDROPTEXTDROPTEXTMESSAGESETDATAY>TC\ 'O' oFormMenu = oContextMenu.AddMenu(TOOLMENU_ADDTO_LOC) ENDIF oFormMenu.SubMenu.AddMenu(m.cWinName, [oRef.DropOnContainer(.NULL., "] + m.cWinName + [")]) ENDIF ENDFOR RETURN ENDPROC PROCEDURE getpropertyset * Given a property list, return a string that * can be used in code to set the properties. * For example, if the property list is as follows: * name=Ryan * success=.F. * year=1970 * * Then return this: * name="RMK" * success=.F. * year=1970 * #define CRLF CHR(13) + CHR(10) #define TAB CHR(9) LPARAMETERS cPropertyList LOCAL oPropertyCollection LOCAL cPropertyName LOCAL cPropertyValue LOCAL i LOCAL cPropSet LOCAL nSelect m.nSelect = SELECT() SELECT 0 m.cPropSet = '' IF VARTYPE(m.cPropertyList) == 'C' AND !EMPTY(m.cPropertyList) * Parse the property list into a collection m.oPropertyCollection = THIS.ParsePropertyList(m.cPropertyList) * -- set any properties specified by "properties" FOR m.i = 1 TO m.oPropertyCollection.Count m.cPropertyName = m.oPropertyCollection.GetKey(m.i) IF !EMPTY(m.cPropertyName) AND !INLIST(m.cPropertyName, "MemberCount", "ContainerClass", "ContainerClassLib") m.cPropertyValue = TRANSFORM(NVL(THIS.EvalText(m.oPropertyCollection.Item(m.i)), '')) * if we have parens in the return, assume it's a characeter type * otherwise our TYPE() function tries to re-evaluate it IF (AT('(', m.cPropertyValue) > 0 AND AT(')', m.cPropertyValue) > 0) OR INLIST(TYPE(m.cPropertyValue), 'C', 'U') m.cPropSet = m.cPropSet + TAB + m.cPropertyName + " = " + ["] + m.cPropertyValue + ["] + CRLF ELSE m.cPropSet = m.cPropSet + TAB + m.cPropertyName + " = " + TRANSFORM(m.cPropertyValue) + CRLF ENDIF ENDIF ENDFOR ENDIF SELECT (m.nSelect) RETURN m.cPropSet ENDPROC PROCEDURE ondblclick LOCAL oWindowCollection LOCAL oContextMenu PRIVATE oRef * if they press enter, add to open SCX or VCX oWindowCollection = THIS.GetOpenForms() DO CASE CASE oWindowCollection.Count == 1 THIS.DropOnContainer(.NULL., oWindowCollection.Item(1)) CASE oWindowCollection.Count > 1 m.oContextMenu = NEWOBJECT("ContextMenu", "foxmenu.prg", _TOOLBOX) THIS.CreateFormMenu(m.oContextMenu, .T.) m.oRef = THIS m.oContextMenu.Show(.3, .4) m.oContextMenu = .NULL. ENDCASE ENDPROC PROCEDURE onkeypress * When return is pressed, simply drop * on the open container in the upper left corner LPARAMETERS nKeyCode, nShiftAltCtrl LOCAL oWindowCollection LOCAL oContextMenu PRIVATE oRef * find our drop target IF m.nKeyCode == 13 *!* * if they press enter, add to open SCX or VCX *!* oWindowCollection = THIS.GetOpenForms() *!* DO CASE *!* CASE oWindowCollection.Count == 1 *!* THIS.DropOnContainer(.NULL., oWindowCollection.Item(1)) *!* CASE oWindowCollection.Count > 1 *!* m.oContextMenu = NEWOBJECT("ContextMenu", "foxmenu.prg", IIF(ATC(".APP", SYS(16)) > 0, SYS(16), '')) *!* THIS.CreateFormMenu(m.oContextMenu, .T.) *!* m.oRef = THIS *!* m.oContextMenu.Show(.3, .4) *!* m.oContextMenu = .NULL. *!* ENDCASE RETURN .T. ENDIF RETURN .F. ENDPROC PROCEDURE oncreatedatavalues #include "toolbox.h" THIS.AddDataValue("baseclass", '', DATAVALUE_BASECLASS_LOC, '', .T., "cfoxtextbox") THIS.AddDataValue("objectname", '', DATAVALUE_OBJECTNAME_LOC, '', .F., "cfoxtextbox") THIS.AddDataValue("properties", '', DATAVALUE_PROPERTIES_LOC, '', .F., "cfoxpropertybox") THIS.AddDataValue("runbuilder", '', DATAVALUE_BUILDER_LOC, '', .F., "cfoxbuildercombo") ENDPROC PROCEDURE oncompletedrag LPARAMETERS nEffect, oDropTarget, nMouseXPos, nMouseYPos THIS.DropOnContainer(m.oDropTarget, '', m.nMouseXPos, m.nMouseYPos) RETURN ENDPROC PROCEDURE onolesetdata #include "foxpro.h" #define VK_CONTROL 0x11 #define CRLF CHR(13) + CHR(10) #define TAB CHR(9) LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos LOCAL ClassLib LOCAL ClassName LOCAL ObjectName LOCAL ObjName LOCAL BaseClass LOCAL PropertyList LOCAL cDropText LOCAL nSelect LOCAL oException LOCAL lCtrlKeyPressed IF VARTYPE(m.eFormat) == 'N' AND m.eFormat == CF_TEXT AND VARTYPE(m.oDropTarget) <> 'O' * we're not dropping on an object container, so assume * we're dropping text -- create the code to instantiate the object m.BaseClass = THIS.EvalText(NVL(THIS.GetDataValue("baseclass"), '')) m.ClassName = m.BaseClass m.ClassLib = '' m.ObjectName = THIS.EvalText(NVL(THIS.GetDataValue("objectname"), '')) m.PropertyList = THIS.EvalText(NVL(THIS.GetDataValue("properties"), '')) IF EMPTY(m.ObjectName) m.ObjectName = 'o' ENDIF m.ObjName = m.ObjectName m.cDropText = '' DECLARE INTEGER GetKeyState IN user32 INTEGER vKey m.lCtrlKeyPressed = BITTEST(GetKeyState(VK_CONTROL), 15) CLEAR DLLS "GetKeyState" IF m.lCtrlKeyPressed m.cDropText = THIS.EvalText(THIS.oEngine.CtrlDropText) IF VARTYPE(m.cDropText) <> 'C' OR EMPTY(m.cDropText) m.cDropText = ; [DEFINE CLASS ] + m.ObjectName + [ AS ] + m.BaseClass + CRLF + ; THIS.GetPropertySet(m.PropertyList) + CRLF + ; TAB + [PROCEDURE Init] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; TAB + [PROCEDURE Destroy] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; TAB + [PROCEDURE Error(nError, cMethod, nLine)] + CRLF + CRLF + ; TAB + [ENDPROC] + CRLF + CRLF + ; [ENDDEFINE] ENDIF ELSE m.cDropText = THIS.EvalText(THIS.oEngine.DropText) IF VARTYPE(m.cDropText) <> 'C' OR EMPTY(m.cDropText) m.cDropText = m.ObjectName + [ = CREATEOBJECT("] + m.BaseClass + [")] ENDIF ENDIF IF !EMPTY(m.cDropText) m.nSelect = SELECT() SELECT 0 && make sure we won't end up evaluating a field from a table TRY m.cDropText = TEXTMERGE(m.cDropText, .T., "<<", ">>") CATCH TO oException m.cDropText = oException.Message ENDTRY SELECT (m.nSelect) ENDIF m.oDataObject.SetData(m.cDropText, m.eFormat) ENDIF ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu LOCAL cBaseClass LOCAL oMenuBar m.cBaseClass = LOWER(NVL(THIS.GetDataValue("baseclass"), '')) IF !INLIST(m.cBaseClass, "exception", "column", "header", "session") && these aren't supported by CREATE CLASS oContextMenu.Addmenu(TOOLMENU_CREATESUBCLASS_LOC, [oRef.CreateSubclass()]) ENDIF IF m.cBaseClass == "form" oContextMenu.Addmenu(TOOLMENU_CREATEFORM_LOC, [oRef.CreateForm()]) ENDIF THIS.CreateFormMenu(m.oContextMenu) ENDPROC  k k EB%  k< U2(C\%&fU\,C\>") CATCH TO oException m.cTemplate = oException.Message ENDTRY ENDIF RETURN m.cTemplate ENDPROC PROCEDURE onolesetdata #include "foxpro.h" LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos IF VARTYPE(m.eFormat) == 'N' AND m.eFormat == 1 IF VARTYPE(m.oDropTarget) == 'O' && AND INLIST(m.oDropTarget.BaseClass, "Form", "Formset", "Page", "Container", "Column", "Toolbar") RETURN .F. ELSE m.oDataObject.SetData(THIS.GetProxyCode(), m.eFormat) ENDIF ENDIF ENDPROC PROCEDURE oncreatedatavalues #include "toolbox.h" THIS.AddDataValue("classlib", '', '', '', .F.) THIS.AddDataValue("classname", '', '', '', .F.) THIS.AddDataValue("baseclass", '', '', '', .F.) THIS.AddDataValue("parentclass", '', '', '', .F.) THIS.AddDataValue("id", '', '', '', .F.) THIS.AddDataValue("template", '', DATAVALUE_TEMPLATE_LOC, '', .F., "cfoxeditbox") THIS.AddDataValue("wsdl", '', DATAVALUE_WSDL_LOC, '', .F., "cfoxtextbox") THIS.AddDataValue("uri", '', DATAVALUE_URI_LOC, '', .F., "cfoxtextbox") THIS.AddDataValue("service", '', DATAVALUE_SERVICE_LOC, '', .F., "cfoxtextbox") THIS.AddDataValue("port", '', DATAVALUE_PORT_LOC, '', .F., "cfoxtextbox") THIS.AddDataValue("wsml", '', DATAVALUE_WSML_LOC, '', .F., "cfoxtextbox") THIS.AddDataValue("class", '', DATAVALUE_CLASS_LOC, '', .F., "cfoxtextbox") IF THIS.lShowObjectName THIS.AddDataValue("objectname", '', DATAVALUE_OBJECTNAME_LOC, '', .F., "cfoxtextbox") ELSE THIS.AddDataValue("objectname", '', '', '', .F.) ENDIF IF THIS.lShowProperties THIS.AddDataValue("properties", '', DATAVALUE_PROPERTIES_LOC, '', .F., "cfoxpropertybox") ELSE THIS.AddDataValue("properties", '', '', '', .F.) ENDIF THIS.AddDataValue("runbuilder", '', DATAVALUE_BUILDER_LOC, '', .F., "cfoxbuildercombo") ENDPROC PROCEDURE droponcontainer * Drop a class on the current container #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDropTarget, cSCXName, nXPos, nYPos LOCAL cObjName LOCAL cPropertyList LOCAL cClassName LOCAL cClassLib LOCAL cOriginalObjName LOCAL cNewPropertyList m.cClassLib = THIS.EvalText(NVL(THIS.GetDataValue("classlib"), '')) m.cClassName = THIS.EvalText(NVL(THIS.GetDataValue("classname"), '')) m.cOriginalObjName = THIS.EvalText(NVL(THIS.GetDataValue("objectname"), '')) m.cPropertyList = THIS.EvalText(NVL(THIS.GetDataValue("properties"), '')) IF EMPTY(m.cClassLib) m.cClassLib = HOME() + "ffc\_ws3client.vcx" m.cClassName = '' ENDIF IF EMPTY(m.cClassName) m.cClassName = "wshandler" ENDIF m.cPropertyList = ; TEXTMERGE( ; [wsdl=<>] + CHR(10) + ; [port=<>] + CHR(10) + ; [service=<>] + CHR(10) + ; [wsname=<>] + CHR(10) + ; [webserviceid=<>] + CHR(10) + ; [wsml=<>], .F., "<<", ">>") + CHR(10) + ; m.cPropertyList THIS.RunBuilder = NVL(THIS.GetDataValue("runbuilder"), THIS.RunBuilder) THIS.DropObject(m.oDropTarget, m.cSCXName, m.nXPos, m.nYPos, m.cClassName, m.cClassLib, '', m.cOriginalObjName, m.cPropertyList) RETURN ENDPROC PROCEDURE createcontextmenu #include "toolbox.h" LPARAMETERS oContextMenu THIS.CreateFormMenu(oContextMenu) ENDPROC v nvnv_-%fesOjU)T Ca B U OCONTEXTMENUTHIS CREATEMENUUNEFFECT ODROPTARGET NMOUSEXPOS NMOUSEYPOS  T %CShowType "T CShowType H T"T CUniqueID "T CParentID )T C LockDelete y% f%  KT bT #T C 6 H C    C    B U ODATAOBJECTNEFFECTNBUTTONNSHIFTNXCOORDNYCOORD CSHOWTYPE CSRCUNIQUEID CSRCPARENTID LLOCKDELETE NNEWEFFECT GETFORMATTHIS GETDRAGDATAPARENTIDOENGINECOPYTOOLUNIQUEIDMOVETOOL)BU ODATAOBJECTNEFFECTNBUTTONNSHIFTNXCOORDNYCOORDNSTATE5%CO.CUTHISOENGINE RENAMEITEMUNIQUEID6%CO/CaUTHISOENGINE DELETEITEMUNIQUEID  BU ODATAOBJECTNEFFECT %C T C '%CCCC  #T C CC = T  B U ODATAOBJECTCFORMATXDATA GETFORMATGETDATA UNEFFECT EMOUSECURSOR% %COu+TC ContextMenu foxmenu.prgS %C C  % C\- % ,C\T C  \T  RUNDLL32.EXE'Tshell32.dll,OpenAs_RunDLL 5T CCopen      B U CFILE CPARAMETERSCRUNCSYSDIR NRETVALUEGETDESKTOPWINDOWUSER32DLLGETSYSTEMDIRECTORYKERNEL32 SHELLEXECUTESHELL32 COPERATION U OCONTEXTMENU+TC DATASESSIONv G(UTHISNDATASESSIONIDG(UTHISNDATASESSIONID 23      !"#$%&'() * + , -./T T T T ! T (-6T C OC C C  %  H C.VCX '(TCLASS DESIGNER -   C.SCX m)T FORM DESIGNER -  2)T FORM DESIGNER -  %C  C   t, %C*`9%CC *0FormFormsetPage Pageframe ContainerGridColumnToolbar Optiongroup CommandgroupDataenvironment Cm.aFrmObj[1].ParentbO W%C *10Form&Cm.aFrmObj[1].Parent.CaptionbC Cm.aFrmObj[1].NamebC C *12C *3 5T C*ST C*1rT C*"%C AddObjecth 56%Cm.oDropTarget.TopbNC N T  47%Cm.oDropTarget.LeftbNC N 1T  5q%C*`mT C*<* T*;T .C92T /C92%C O74%C,CC,3@toolbox  < ,B| GetKeyStateuser32%CC6%C,T$C,'+CoTempObject.ParentbO%$10Form!T$$1`%CoTempObject.Parent.CaptionbCCoTempObject.NamebC $12$3 oT  $T C ,T C ,T C,T C ,T C , T$<$%C O%C,T C,V GetKeyState < ,%C CeT :%C O CC Session Exception % T uC\This class has no visual representation and therefore cannot be dropped onto this container.0ToolboxxO%C C C  C O C BaseClassh 1%C  T  T C %C 0FormFormsetPage Pageframe ContainerGridColumnToolbar Optiongroup CommandgroupDataenvironment  %Cm.oDropTarget.ParentbOC 10FormFormsetPage Pageframe ContainerGridColumnToolbar Optiongroup CommandgroupDataenvironment `Cm.oDropTarget.Parent.CaptionbCCm.oDropTarget.NamebC  12 3  h T  1 < EC,Cannot add objects to non-container classes.0ToolboxxBT  T T  (+Cm.oTopObject.ParentbO :%Cm.oTopObject.ScaleModebN 8 n T  !T  1%C O !%C  ScaleModeh T  8 T T 8T  (+Cm.oTopObject.ParentbO A%Cm.oTopObject.CaptionbCC  C 2  T  2T  1%C N T %C NT s%C O0Column  Column CoDropTarget.ParentbO 10Grid T  1%C O1"%C CC  T  %C CT %C C/T T C 9:T C 9;$T CCC fDLLOCX%C  &B%+%0Grid Column b%C@Do you want to add a column to the grid to contain this control?$ToolboxxT<C<DT $C<=<T  $ < $ T (a T  H>% CO. 0 Pageframe Page T !O%C>fC f2C?fC fC?C fPAGE   T@@L%CIDropping this class will result in destroying the existing member classesC ,and recreating new ones based on new values.C C JThis will result in loss of property settings, new, added, and/or modifiedC method code, and added objects.C C Do you want to continue?$ToolboxxT> T?  () 0Page Page ]%C1>fC f=C1?fC f%CC1?ҡC fPAGE   T1@1@L%CIDropping this class will result in destroying the existing member classesC ,and recreating new ones based on new values.C C JThis will result in loss of property settings, new, added, and/or modifiedC method code, and added objects.C C Do you want to continue?$ToolboxxT A 1 T  T  < < TA> TA? TA@ (+ 0Grid Column V%C>fC f9C?fC f$CC?ҡC fCOLUMN   CT<C<DL%CIDropping this class will result in destroying the existing member classesC ,and recreating new ones based on new values.C C JThis will result in loss of property settings, new, added, and/or modifiedC method code, and added objects.C C Do you want to continue?$ToolboxxT> T?  (: 0 OptiongroupC  Optionbutton \%C>fC f?C?fC f*CC?ҡC f OPTIONBUTTON   TBBL%CIDropping this class will result in destroying the existing member classesC ,and recreating new ones based on new values.C C JThis will result in loss of property settings, new, added, and/or modifiedC method code, and added objects.C C Do you want to continue?$ToolboxxT> T?  (- 0Column Header $0%CCfC fCDfC f }T% (BCGDropping this class will result in destroying the existing header classC -and recreating a new one based on new values.C C JThis will result in loss of property settings, new, added, and/or modifiedC method code, and added objects.C C Do you want to continue?$Toolboxx TC TD  ( CEx2>%% a&C olecontrol F%C  T C C T m-T "CCContainerClass H9G0T #CCContainerClassLib H9G(%C "C # C #0 iT "T #T "T # H Page-T  T   T C " Pageframe T  #T C 9;  OptionbuttonT  T  "T C " Optiongroup T  #T C 9; ColumnFT  T  T C "Grid T  #T C 9; HeaderT  T  %C C FC  I %m.oObjRef = oDropTarget.&cObjName  %C O:%T 3 % B!M%C WidthhC Widthh C Widthh   T J P%C HeighthC Heighth C Heighth >!2!T K:!6%%C  #!*T !CC MemberCount H9G%C !C!T !C !g%C !N!T !!T ! H"# 0 Pageframe"%C g"T > T ? % !"T @ !! 0 Optiongroup #%C "T > T ? % !#T B ! 0Grid#%C t#T > T ? % !#T < !% 0Column2%%9LM$#T N 3$% ( 9LO .%"% ( P%%%C Q3Text1%% (yC`Do you want to replace the default Text1 control with the control you are adding to this column?$Toolboxx %CText1 R!*%(S&%C T%@C'Container is not valid for this object.0Toolboxx&1T CC T code  from g H%& N&@C'Container is not valid for this object.0Toolboxx2&6CCC TC: T\0Toolboxx (&C E0Toolboxx%C O1O'J%C LefthC Lefth C Lefth K'T 5 W''G%C TophC Toph C Toph 'T 4 'J(`%C VisiblehC Visibleh C Visibleh U F(T UaR(X%Cm.oObjRef.ClassLibrarybC C V Cm.oObjRef.AutoSizebL ))T Wa$%Cm.oObjRef.HeightbN) )T K K)#%Cm.oObjRef.WidthbNg)[)T J Jc)CAutoSize X)n%Cm.oObjRef.ClassbCCm.oObjRef.BaseClassbC  YTimer  0Timer *$%Cm.oObjRef.HeightbNM*A*T KI*#%Cm.oObjRef.WidthbN**T J* ( Z,T C [T CC H_%C  ,*%C f.T.C f.F. D+T Lm+!T C m.oObjRef. b, H+|, N+4m.oObjRef.&cPropertyName = VAL(m.cPropertyValue)  LE,cm.oObjRef.&cPropertyName = (UPPER(m.cPropertyValue) == ".T." OR UPPER(m.cPropertyValue) == "T") 2|,/m.oObjRef.&cPropertyName = m.cPropertyValue ,%  -.%C O C  C  -!%C m.oObjRef.TopbN-T T &%   0Column H. . /P%C 0 Container Commandgroup Pageframe OptiongroupGrid@. H-". - . / ". . / . /%C Refreshh~.C \%C O..% .C ScaleMode X.T 8 .#%C C C  Z5T C <> HV .T. Ca .F.5C-2VC  TTaBU CTOOLDATACVALUETHISLTOOLDATAPARSEDTOOLDATA ODATAVALUEODATACOLLECTIONDATANAME SETDATAVALUEUT rCT  <>C_C  T B U ODATAVALUECENCODEDTHISODATACOLLECTIONDATANAME DATAVALUE BU BUTHISHELPFILE BaU B-UNKEYCODE NSHIFTALTCTRL BCUTHISENCODETOOLDATA0TC  BU CTOOLDATATHISTOOLDATA PARSETOOLDATA T C CollectionNT CSCREEN   ( 'T CSCREEN  "  (T C  H( CFORM DESIGNER - N/T CC CFORM DESIGNER -@) CCLASS DESIGNER - 0T CC CCLASS DESIGNER -@2T %C  C   B U NTOTALWINDOWSIOWINDOWCOLLECTIONCWINNAME ATMPARRAYADD5 H$. Ctg2C      Ct,C     Ct&C    Ct  C  2.C U CUNIQUEIDP1P2P3P4THISOENGINE INVOKEADDIN T C CollectionN%C T C -C  ( T C=C % !T CC  =!T CC  \%C  T C  %C  wC     B U CPROPERTYLISTINCNTNPOS CPROPERTYNAMECPROPERTYVALUEOPROPERTYCOLLECTION APROPERTYLISTTHISEVALTEXTADDB >T CC  -!@#$%^&*()+={}[]:;?/<>,\|~`'"&%C 9 C =_ T o T T  C _ +a0/IF TYPE("oDropTarget.&cObjName.") = "U"!T  T  C _ B U ODROPTARGETCORIGINALOBJNAMEICOBJNAME/%CO(CUTHISOENGINE ADDCLASSLIB5%CO.CUTHISOENGINEADDTOFAVORITESUNIQUEID1T CHELPv%C C0 ocG(kT  HELP NOWAIT%+T HELP ID C_ NOWAIT &cHelpCmd %C  C 0 G(*G( UCHELPCMD CHELPFILE CSAVEHELPFILETHISHELPFILEHELPIDS%Ct =T  %CCC  l B "%C CC  B T (0TCregistrytoolboxregistry.vcxS+%C   $T  AT   B UCOPTIONCKEYPATHCDEFAULTORECCVALUEOREG GETREGKEYk        T  >+Cm.oFormbO C  Form T  -%C O Form . < BT CWT C DataSessionvG( T T C @T Cy ( !%CCC &@ T C !T C % mFRQ T CiT %C 8!T CCDATABASE @#T CC SOURCENAME @T C`%  T C<%C OT C b ( T C m.oObjRef = m.oDE.&cObjName Q%C O Cursor       < < F B"T C CursorC Cursor m.oObjRef = m.oDE.&cObjName %C OT CC@T  %C  T   T % + Q  <  <  < G(  F U ODROPTARGETCTABLEODENCNTOOBJREFCOBJNAMEICSOURCE CDATABASECALIASNSELECTOFORMNDATASESSIONID LOPENTABLEAINUSEADATAENV ACHILDREN BASECLASSPARENT DATASESSIONID CURSORSOURCEDATABASETHISGETUNIQUEOBJNAME ADDOBJECTALIAS TC   % %C C\- % @TC %C C (C 0ToolboxxC 9TC oRef.InvokeAddIn("") U OCONTEXTMENU CTOOLTYPEID CPARENTIDOADDINCOLLECTIONOADDIN OMENUITEM OEXCEPTIONTHISOENGINE GETADDINSCOUNTADDMENUISMENU ADDINNAMEMENUCODESUBMENUMESSAGECREATEADDINSMENUUNIQUEIDTTUTHISODATACOLLECTIONOENGINEI CTC CollectionN CTUTHISODATACOLLECTIONONCREATEDATAVALUESTOOLDATA onrightclick,oncompletedragy ondragdrop ondragover renameitem deleteitems onstartdrag getdragdataondraggivefeedback createmenu addcategory customize evaltextE onolesetdata adddatavalue2 getdatavaluek setdatavalue propertiesimagefile_accessshelltoocreatecontextmenupushdspopdsW dropobject parsetooldata-Noncreatedatavalues Pencodetooldata'P getimagefileP gethelpfile Qoncreate/Q onkeypress=Qtooldata_accessoQtooldata_assignQ getopenformsQ invokeaddin9TparsepropertylistUgetuniqueobjnameW addclasslib:YaddtofavoritesYshowhelpYgetregistryvalue\[ addtodataenv\createaddinsmenu]cDestroyeInitf1rB423qqqqq!A!!aA1A12BAA3r3aA2qA23qrq1AA23qqqqqqRAsB!AAAAb!AA1aDAAASa!AAaAAB3A2aA3tAA3ss32q"qAArArAqAqAqAr!r4uqqq"qA!rAB3qq"qA!B4sA3"A4qqqd(rA21!qQA3q5337qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqeAAb1 1aA1A"aAAqAAA1AAqaaqBAArqAAAQQ1QQAqAAra1AAABArAQAA1SBQAAAAAAAsAA!AAABAsAqA<AAs!AqAqAB#!qAAQr!!AAAA"!AAAb!!AAAr!!AAAA!!AAAb"AAAAq"BABQArA!AA!AA"q1AqAA!AAA1AA!AAA1AA!AAA1AAAA2qAAQqAAAAABACAAAAAAaAAAAAsAAAqAAAAAAqAA1qAAAAA!AA1!AAA#AAAA1AAAAAAAAcAA11AAaAAAAArAAAAA2AAA2AAAAAB"AABAA3sqBr!A"q"QQaAaAAAAAB3:sq"1A434w3s23q5sqqqqA"aA"QAA3u!aA4wqqqqqq"1!!AAAAAA3qqaaAAAQA3A2aA3qqqAAAAaAA3qqAA!AAA3qqqqqqqqqqqqqAAAA1AAAA3AA"1r11qraAqAAA"As1A!AAAAAAB3qqqqA!Aq2AAAAA3222 (?+@F/K3&P6% WBN iD <n~^@_?o $ |"C"s#]#+$gI$+q+1,N,,,, -Eȑ`<Ya~j*lLnt ps_u "y--U%ɤk˧$IѨ+ ϭyh}wϻh)nvsPROCEDURE onrightclick #include "toolbox.h" LOCAL oContextMenu m.oContextMenu = THIS.CreateMenu(.T.) RETURN m.oContextMenu ENDPROC PROCEDURE oncompletedrag * abstract method LPARAMETERS nEffect, oDropTarget, nMouseXPos, nMouseYPos ENDPROC PROCEDURE ondragdrop #include "foxpro.h" #include "toolbox.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord LOCAL cShowType LOCAL cSrcUniqueID LOCAL cSrcParentID LOCAL lLockDelete LOCAL nNewEffect m.nNewEffect = .NULL. * -- if this is a tool, move or copy it within the toolbox IF oDataObject.GetFormat("ShowType") m.cShowType = THIS.GetDragData(oDataObject, "ShowType") DO CASE CASE m.cShowType == SHOWTYPE_TOOL m.cSrcUniqueID = THIS.GetDragData(oDataObject, "UniqueID") m.cSrcParentID = THIS.GetDragData(oDataObject, "ParentID") m.lLockDelete = THIS.GetDragData(oDataObject, "LockDelete") == 'y' IF m.lLockDelete IF THIS.ParentID == m.cSrcParentID m.nNewEffect = DROPEFFECT_MOVE ELSE m.nNewEffect = DROPEFFECT_COPY ENDIF ELSE m.nNewEffect = IIF(m.nShift == 2, DROPEFFECT_COPY, DROPEFFECT_MOVE) ENDIF DO CASE CASE m.nNewEffect == DROPEFFECT_COPY THIS.oEngine.CopyTool(m.cSrcUniqueID, THIS.UniqueID) CASE m.nNewEffect == DROPEFFECT_MOVE THIS.oEngine.MoveTool(m.cSrcUniqueID, THIS.UniqueID) ENDCASE ENDCASE ENDIF RETURN m.nNewEffect ENDPROC PROCEDURE ondragover #include "foxpro.h" LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState RETURN .NULL. ENDPROC PROCEDURE renameitem IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.RenameItem(THIS.UniqueID) ENDIF ENDPROC PROCEDURE deleteitem IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.DeleteItem(THIS.UniqueID, .T.) ENDIF ENDPROC PROCEDURE onstartdrag #include "foxpro.h" LPARAMETERS oDataObject, nEffect RETURN DROPEFFECT_COPY + DROPEFFECT_MOVE ENDPROC PROCEDURE getdragdata * -- Utility function to return drag data * -- by stripping off the null at the end LPARAMETERS oDataObject, cFormat LOCAL xData IF oDataObject.GetFormat(m.cFormat) m.xData = oDataObject.GetData(m.cFormat) IF VARTYPE(xData) == 'C' AND AT(CHR(0), xData) > 0 m.xData = LEFT(m.xData, AT(CHR(0), m.xData) - 1) ENDIF ELSE m.xData = .NULL. ENDIF RETURN m.xData ENDPROC PROCEDURE ondraggivefeedback * abstract method LPARAMETERS nEffect, eMouseCursor ENDPROC PROCEDURE createmenu * Create a context menu object * [lDefault] = TRUE to add default items * [oContextMenu] = optional existing menu #include "toolbox.h" LPARAMETERS lDefault, oContextMenu LOCAL oFilterCollection LOCAL oFilter LOCAL oMenuItem LOCAL oAddInCollection LOCAL oAddIn LOCAL oCategory IF VARTYPE(oContextMenu) <> 'O' oContextMenu = NEWOBJECT("ContextMenu", "foxmenu.prg", _TOOLBOX) ENDIF IF lDefault * CreateContextMenu() adds additional menu items specific to this tool THIS.CreateContextMenu(oContextMenu) * Add any add-ins that might exist THIS.CreateAddInsMenu(oContextMenu, THIS.ToolTypeID) IF oContextMenu.MenuBarCount > 0 oContextMenu.Addmenu("\-") ENDIF IF !THIS.LockRename oContextMenu.Addmenu(TOOLMENU_RENAME_LOC, [oRef.RenameItem()]) ENDIF IF !THIS.LockDelete oContextMenu.Addmenu(TOOLMENU_DELETE_LOC, [oRef.DeleteItem()]) ENDIF IF !THIS.IsVirtual oContextMenu.Addmenu(TOOLMENU_PROPERTIES_LOC, [oRef.Properties()]) ENDIF IF (!THIS.LockRename OR !THIS.LockDelete OR !THIS.IsVirtual) AND oContextMenu.MenuBarCount > 0 oContextMenu.Addmenu("\-") ENDIF IF !THIS.LockAdd oContextMenu.Addmenu(TOOLMENU_ADDCLASSLIB_LOC, [oRef.AddClassLib()]) ENDIF oContextMenu.Addmenu(TOOLMENU_ADDCATEGORY_LOC, [oRef.AddCategory()]) * oContextMenu.Addmenu(TOOLMENU_REFRESH_LOC, [oForm.RefreshToolbox()]) oContextMenu.Addmenu(TOOLMENU_REFRESHCATEGORY_LOC, [oForm.RefreshCategory()]) oContextMenu.Addmenu(TOOLMENU_CUSTOMIZE_LOC, [oRef.Customize()]) * show the available filters oFilterCollection = THIS.oEngine.GetFilters() IF oFilterCollection.Count > 0 oMenuItem = oContextMenu.AddMenu(TOOLMENU_FILTERS_LOC) oMenuItem.SubMenu.AddMenu(TOOLMENU_NOFILTER_LOC, [oForm.ApplyFilter("")], '', EMPTY(THIS.oEngine.FilterID)) FOR EACH oFilter IN oFilterCollection oMenuItem.SubMenu.AddMenu(oFilter.FilterName, [oForm.ApplyFilter("] + oFilter.UniqueID + [")], '', THIS.oEngine.FilterID == oFilter.UniqueID) ENDFOR ENDIF * get global add-ins that aren't for a specific tool type THIS.CreateAddInsMenu(oContextMenu) IF THIS.ShowType == SHOWTYPE_TOOL m.oCategory = THIS.oEngine.GetToolObject(THIS.ParentID) IF ((THIS.HelpID > 0 OR !EMPTY(THIS.HelpFile)) OR (VARTYPE(m.oCategory) == 'O' AND m.oCategory.ShowType <> SHOWTYPE_FAVORITES)) oContextMenu.Addmenu("\-") ENDIF IF (VARTYPE(m.oCategory) == 'O' AND m.oCategory.ShowType <> SHOWTYPE_FAVORITES) oContextMenu.Addmenu(TOOLMENU_ADDTOFAVORITES_LOC, [oRef.AddToFavorites()]) ENDIF IF THIS.HelpID > 0 OR !EMPTY(THIS.HelpFile) oContextMenu.Addmenu(TOOLMENU_ITEMHELP_LOC, [oRef.ShowHelp]) ENDIF ENDIF ENDIF RETURN oContextMenu ENDPROC PROCEDURE addcategory * Add a new category IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.AddCategory() ENDIF ENDPROC PROCEDURE customize * Customize the toolbox IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.Customize(THIS.ParentID) ENDIF ENDPROC PROCEDURE evaltext * Evaluate passed string. * If it is surrounded by parens, then * evaluate it, otherwise return the original text. LPARAMETERS cText IF VARTYPE(m.cText) == 'C' AND LEFT(m.cText, 1) == '(' AND RIGHT(m.cText, 1) == ')' TRY m.cText = NVL(EVALUATE(m.cText), '') CATCH ENDTRY ENDIF RETURN m.cText ENDPROC PROCEDURE onolesetdata * Put code here to return data for queried eFormat * Return .T. if data was put into oDataObject with SetData() method LPARAMETERS oDataObject, eFormat, oDropTarget, nMouseXPos, nMouseYPos RETURN .F. ENDPROC PROCEDURE adddatavalue * -- Create a new Data value LPARAMETERS cName, xValue, cCaption, cDescription, lIsReadOnly, cEditClass, cEditLibrary, cEditProperty LOCAL oDataProperty IF VARTYPE(m.cName) <> 'C' OR EMPTY(m.cName) RETURN .F. ENDIF IF PCOUNT() < 2 m.xValue = '' ENDIF IF VARTYPE(m.cCaption) <> 'C' m.cCaption = '' ENDIF IF VARTYPE(m.cDescription) <> 'C' m.cDescription = '' ENDIF IF VARTYPE(m.cEditClass) <> 'C' m.cEditClass = '' ENDIF IF VARTYPE(m.cEditLibrary) <> 'C' m.cEditLibrary = '' ENDIF IF VARTYPE(m.cEditProperty) <> 'C' m.cEditProperty = '' ENDIF m.oDataProperty = CREATEOBJECT("empty") AddProperty(m.oDataProperty, "DataName", m.cName) AddProperty(m.oDataProperty, "DataValue", m.xValue) AddProperty(m.oDataProperty, "DataCaption", m.cCaption) AddProperty(m.oDataProperty, "Description", m.cDescription) AddProperty(m.oDataProperty, "IsReadOnly", m.lIsReadOnly) AddProperty(m.oDataProperty, "EditClass", m.cEditClass) AddProperty(m.oDataProperty, "EditLibrary", m.cEditLibrary) AddProperty(m.oDataProperty, "EditProperty", m.cEditProperty) AddProperty(m.oDataProperty, "DataType", VARTYPE(m.xValue)) *!* oDataProperty = NEWOBJECT("_DataValue", THIS.ClassLibrary) *!* WITH oDataProperty *!* .DataName = m.cName *!* .DataValue = m.xValue *!* .DataCaption = m.cCaption *!* .Description = m.cDescription *!* .IsReadOnly = m.lIsReadOnly *!* .EditClass = m.cEditClass *!* .EditLibrary = m.cEditLibrary *!* .EditProperty = m.cEditProperty *!* *!* .DataType = VARTYPE(m.xValue) *!* ENDWITH THIS.oDataCollection.Add(m.oDataProperty, UPPER(m.cName)) RETURN .T. ENDPROC PROCEDURE getdatavalue * -- Return a data value given the data value name, * -- or null if not found #include "foxpro.h" #include "toolbox.h" LPARAMETERS cName LOCAL oDataProperty LOCAL oException LOCAL xValue IF VARTYPE(m.cName) <> 'C' OR EMPTY(m.cName) RETURN .F. ENDIF m.xValue = .NULL. TRY oDataProperty = THIS.oDataCollection.Item(UPPER(m.cName)) m.xValue = oDataProperty.DataValue IF VARTYPE(m.xValue) == 'C' m.xValue = THIS.EvalText(m.xValue) ENDIF CATCH TO oException * no error message, just return the null ENDTRY RETURN m.xValue ENDPROC PROCEDURE setdatavalue * -- Set a Data value that already exists in the collection #include "foxpro.h" #include "toolbox.h" LPARAMETERS cName, xValue LOCAL oDataProperty LOCAL oException IF VARTYPE(m.cName) <> 'C' OR EMPTY(m.cName) RETURN .F. ENDIF oException = .NULL. TRY oDataProperty = THIS.oDataCollection.Item(UPPER(m.cName)) oDataProperty.DataValue = m.xValue CATCH TO oException * no error message, just ignore the setting and return false ENDTRY RETURN ISNULL(oException) ENDPROC PROCEDURE properties * process through the ToolboxEngine because * the engine knows how to save our changes LPARAMETERS lNoAutoSave IF VARTYPE(THIS.oEngine) == 'O' RETURN THIS.oEngine.ShowProperties(THIS, m.lNoAutoSave) ENDIF ENDPROC PROCEDURE imagefile_access *To do: Modify this routine for the Access method IF EMPTY(THIS.ImageFile) RETURN THIS.GetImageFile() ELSE RETURN THIS.ImageFile ENDIF ENDPROC PROCEDURE shellto * Abstract: * This shell out to specified file, which can be a URL (e.g. http://www.microsoft.com), * a filename, etc * * Parameters: * * [cParameters] * used by the ShellTo method #define SW_HIDE 0 #define SW_SHOWNORMAL 1 #define SW_NORMAL 1 #define SW_SHOWMINIMIZED 2 #define SW_SHOWMAXIMIZED 3 #define SW_MAXIMIZE 3 #define SW_SHOWNOACTIVATE 4 #define SW_SHOW 5 #define SW_MINIMIZE 6 #define SW_SHOWMINNOACTIVE 7 #define SW_SHOWNA 8 #define SW_RESTORE 9 #define SW_SHOWDEFAULT 10 #define SW_FORCEMINIMIZE 11 #define SW_MAX 11 #define SE_ERR_NOASSOC 31 LPARAMETERS cFile, cParameters LOCAL cRun LOCAL cSysDir LOCAL nRetValue *-- GetDesktopWindow gives us a window handle to *-- pass to ShellExecute. DECLARE INTEGER GetDesktopWindow IN user32.dll DECLARE INTEGER GetSystemDirectory IN kernel32.dll ; STRING @cBuffer, ; INTEGER liSize DECLARE INTEGER ShellExecute IN shell32.dll ; INTEGER, ; STRING @cOperation, ; STRING @cFile, ; STRING @cParameters, ; STRING @cDirectory, ; INTEGER nShowCmd IF VARTYPE(m.cParameters) <> 'C' m.cParameters = '' ENDIF m.cOperation = "open" m.nRetValue = ShellExecute(GetDesktopWindow(), @m.cOperation, @m.cFile, @m.cParameters, '', SW_SHOWNORMAL) IF m.nRetValue = SE_ERR_NOASSOC && No association exists m.cSysDir = SPACE(260) && MAX_PATH, the maximum path length *-- Get the system directory so that we know where Rundll32.exe resides. m.nRetValue = GetSystemDirectory(@m.cSysDir, LEN(m.cSysDir)) m.cSysDir = SUBSTR(m.cSysDir, 1, m.nRetValue) m.cRun = "RUNDLL32.EXE" cParameters = "shell32.dll,OpenAs_RunDLL " m.nRetValue = ShellExecute(GetDesktopWindow(), "open", m.cRun, m.cParameters + m.cFile, m.cSysDir, SW_SHOWNORMAL) ENDIF RETURN m.nRetValue ENDPROC PROCEDURE createcontextmenu LPARAMETERS oContextMenu * Use AddMenu to add additional menu items to the right-click menu ENDPROC PROCEDURE pushds * push the datasession THIS.nDataSessionID = SET("DATASESSION") SET DATASESSION TO 1 ENDPROC PROCEDURE popds SET DATASESSION TO (THIS.nDataSessionID) ENDPROC PROCEDURE dropobject * Create an object of the specified class on the specified drop target #include "foxpro.h" #include "toolbox.h" #define VK_SHIFT 0x10 #define VK_CONTROL 0x11 LPARAMETERS oDropTarget, cSCXName, nMouseXPos, nMouseYPos, cClassName, cClassLib, cBaseClass, cOriginalObjName, cPropertyList, cContainerClassName, cContainerClassLib, cDETable LOCAL cObjName LOCAL i LOCAL oObjRef LOCAL oException LOCAL cPropertyName LOCAL cPropertyValue LOCAL cDataType LOCAL nCnt LOCAL nPos LOCAL oPropertyCollection LOCAL lActiveX LOCAL cBuilder LOCAL nOleErrorNo LOCAL lPixelMode LOCAL cActiveWindow LOCAL oTopObject LOCAL nScaleMode LOCAL oFormObject LOCAL lNoDrag LOCAL cMemberClass LOCAL cMemberClassLib LOCAL nMemberCount LOCAL cLeafParentClass LOCAL cLeafParentClassLib LOCAL oTempObject LOCAL cClass LOCAL cRunBuilder LOCAL cDropScript LOCAL lNewColumn LOCAL nDataSession LOCAL ARRAY aFrmObj[1] LOCAL ARRAY aPropertyList[1] LOCAL ARRAY aDropTarget[1] LOCAL ARRAY aMousePos[1] LOCAL nScreenRow LOCAL nScreenCol m.cActiveWindow = '' m.cMemberClass = '' m.cMemberClassLib = '' m.nMemberCount = 0 m.lNewColumn = .F. * lNoDrag means it wasn't dragged to the form -- but rather * programmatically being added through the keyboard or such m.lNoDrag = VARTYPE(m.oDropTarget) <> 'O' AND VARTYPE(m.cSCXName) == 'C' AND !EMPTY(m.cSCXName) IF m.lNoDrag DO CASE CASE ATCC(".VCX", m.cSCXName) > 0 cActiveWindow = WIN_VCX_DESIGN_LOC + " " + m.cSCXName CASE ATCC(".SCX", m.cSCXName) > 0 m.cActiveWindow = WIN_SCX_DESIGN_LOC + " " + m.cSCXName OTHERWISE m.cActiveWindow = WIN_SCX_DESIGN_LOC + " " + m.cSCXName ENDCASE IF !EMPTY(m.cActiveWindow) AND WEXIST(m.cActiveWindow) ACTIVATE WINDOW (m.cActiveWindow) ENDIF IF ASELOBJ(aFrmObj) > 0 IF !INLIST(m.aFrmObj[1].BaseClass, "Form", "Formset", "Page", "Pageframe", "Container", "Grid", "Column", "Toolbar", "Optiongroup", "Commandgroup", "Dataenvironment") AND TYPE("m.aFrmObj[1].Parent") == 'O' IF m.aFrmObj[1].Parent.BaseClass == "Form" AND TYPE("m.aFrmObj[1].Parent.Caption") == 'C' AND TYPE("m.aFrmObj[1].Name") == 'C' AND m.aFrmObj[1].Parent.Caption == m.aFrmObj[1].Name m.oDropTarget = aFrmObj[1] ELSE m.oDropTarget = aFrmObj[1].Parent ENDIF ELSE m.oDropTarget = aFrmObj[1] ENDIF IF !PEMSTATUS(m.oDropTarget, "AddObject", 5) IF TYPE("m.oDropTarget.Top") == 'N' AND VARTYPE(m.nMouseYPos) <> 'N' m.nMouseYPos = m.oDropTarget.Top ENDIF IF TYPE("m.oDropTarget.Left") == 'N' AND VARTYPE(m.nMouseXPos) <> 'N' m.nMouseXPos = m.oDropTarget.Left ENDIF ENDIF ELSE IF ASELOBJ(aFrmObj, 1) > 0 m.oDropTarget = aFrmObj[1] ENDIF ENDIF RELEASE aFrmObj aFrmObj = .NULL. ELSE m.nScreenRow = MROW(_SCREEN.Caption, 3) m.nScreenCol = MCOL(_SCREEN.Caption, 3) IF VARTYPE(m.oDropTarget) <> 'O' * don't create objects on the Toolbox form IF AMOUSEOBJ(aDropTarget, 1) > 0 AND LOWER(aDropTarget[2].Name) = "toolbox" RELEASE m.aDropTarget RETURN ENDIF * If control key is pressed, then drop on outermost container DECLARE INTEGER GetKeyState IN user32 INTEGER vKey IF BITTEST(GetKeyState(VK_CONTROL), 15) IF AMOUSEOBJ(aDropTarget, 1) > 0 * first traverse up from our current position until we get the target form or the target form's caption is equal to our caption oTempObject = aDropTarget[1] DO WHILE TYPE("oTempObject.Parent") == 'O' IF oTempObject.Parent.BaseClass == "Form" EXIT ENDIF oTempObject = oTempObject.Parent ENDDO IF TYPE("oTempObject.Parent.Caption") == 'C' AND TYPE("oTempObject.Name") == 'C' AND oTempObject.Parent.Caption == oTempObject.Name m.oDropTarget = m.oTempObject m.nMouseYPos = m.aDropTarget[4] m.nMouseXPos = m.aDropTarget[3] ELSE m.oDropTarget = aDropTarget[2] m.nMouseYPos = m.aDropTarget[4] m.nMouseXPos = m.aDropTarget[3] ENDIF oTempObject = .NULL. RELEASE oTempObject ENDIF ENDIF IF VARTYPE(m.oDropTarget) <> 'O' IF AMOUSEOBJ(aDropTarget) > 0 m.oDropTarget = aDropTarget[1] ENDIF ENDIF CLEAR DLLS "GetKeyState" RELEASE m.aDropTarget ENDIF ENDIF IF VARTYPE(m.cBaseClass) <> 'C' m.cBaseClass = '' ENDIF IF VARTYPE(m.oDropTarget) == 'O' AND INLIST(PROPER(m.cBaseClass), "Session", "Exception") m.oDropTarget = .NULL. MESSAGEBOX(ERROR_NONVISUALDROP_LOC, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDIF IF VARTYPE(m.cClassName) == 'C' AND !EMPTY(m.cClassName) AND VARTYPE(m.oDropTarget) == 'O' AND PEMSTATUS(m.oDropTarget, "BaseClass", 5) IF EMPTY(m.cBaseClass) m.cBaseClass = m.cClassName ENDIF m.cBaseClass = PROPER(m.cBaseClass) * if the current drop target isn't a container, then try its parent IF !INLIST(m.oDropTarget.BaseClass, "Form", "Formset", "Page", "Pageframe", "Container", "Grid", "Column", "Toolbar", "Optiongroup", "Commandgroup", "Dataenvironment") IF TYPE("m.oDropTarget.Parent") == 'O' AND ; INLIST(m.oDropTarget.Parent.BaseClass, "Form", "Formset", "Page", "Pageframe", "Container", "Grid", "Column", "Toolbar", "Optiongroup", "Commandgroup", "Dataenvironment") AND ; (TYPE("m.oDropTarget.Parent.Caption") <> 'C' OR TYPE("m.oDropTarget.Name") <> 'C' OR m.oDropTarget.Parent.Caption <> m.oDropTarget.Name) m.oDropTarget = m.oDropTarget.Parent ELSE RELEASE m.oDropTarget MESSAGEBOX(ERROR_NONCONTAINER_LOC, MB_ICONEXCLAMATION, TOOLBOX_LOC) RETURN ENDIF ENDIF * set the scale mode to pixels m.nScaleMode = 3 m.oFormObject = .NULL. m.oTopObject = m.oDropTarget DO WHILE TYPE("m.oTopObject.Parent") == 'O' IF TYPE("m.oTopObject.ScaleMode") == 'N' AND m.oTopObject.ScaleMode <> 3 m.oFormObject = m.oTopObject EXIT ENDIF m.oTopObject = m.oTopObject.Parent ENDDO IF VARTYPE(m.oFormObject) == 'O' IF PEMSTATUS(m.oFormObject, "ScaleMode", 0) m.nScaleMode = m.oFormObject.ScaleMode ELSE m.nScaleMode = -1 && means we need to do a ResetToDefault when done ENDIF m.oFormObject.ScaleMode = 3 && set to pixels ENDIF * get design form window name m.oTopObject = m.oDropTarget DO WHILE TYPE("m.oTopObject.Parent") == 'O' && AND TYPE("m.oTopObject.Parent.Top") == 'N' IF TYPE("m.oTopObject.Caption") == 'C' AND EMPTY(m.cActiveWindow) AND WEXIST(m.oTopObject.Caption) m.cActiveWindow = m.oTopObject.Caption ENDIF m.oTopObject = m.oTopObject.Parent ENDDO IF VARTYPE(m.nMouseXPos) <> 'N' m.nMouseXPos = 0 ENDIF IF VARTYPE(m.nMouseYPos) <> 'N' m.nMouseYPos = 0 ENDIF * used keyboard to add control, so offset as necessary *!* m.oExistingRef = SYS(1270, m.nMouseXPos + m.nLeftOffset, m.nMouseYPos + m.nTopOffset) *!* DO WHILE VARTYPE(m.oExistingRef) == 'O' AND !(m.oExistingRef.Name == m.oTopObject.Name) *!* m.nMouseXPos = m.nMouseXPos + 10 *!* m.nMouseYPos = m.nMouseYPos + 10 *!* m.oExistingRef = SYS(1270, m.nMouseXPos + m.nLeftOffset, m.nMouseYPos + m.nTopOffset) *!* ENDDO * if dropping a column onto a column, then change the drop target to the grid instead IF VARTYPE(m.oDropTarget) == 'O' AND oDropTarget.BaseClass == "Column" AND m.cBaseClass == "Column" AND TYPE("oDropTarget.Parent") == 'O' AND oDropTarget.Parent.BaseClass == "Grid" m.oDropTarget = m.oDropTarget.Parent ENDIF IF VARTYPE(m.oDropTarget) == 'O' IF VARTYPE(m.cOriginalObjName) <> 'C' OR EMPTY(m.cOriginalObjName) m.cOriginalObjName = m.cClassName ENDIF IF VARTYPE(m.cClassLib) <> 'C' m.cClassLib = '' ENDIF IF VARTYPE(m.cPropertyList) <> 'C' m.cPropertyList = '' ENDIF * Parse the property list into a collection m.oPropertyCollection = THIS.ParsePropertyList(m.cPropertyList) m.cObjName = THIS.GetUniqueObjName(m.oDropTarget, m.cOriginalObjName) m.lActiveX = INLIST(UPPER(JUSTEXT(m.cClassLib)), "DLL", "OCX") * make sure we can locate the file IF !EMPTY(m.cClassName) TRY * if dropping a control on a grid (and it's not a column), ask to add a column IF oDropTarget.BaseClass == "Grid" AND m.cBaseClass <> "Column" IF MESSAGEBOX(DROPOBJECT_CREATECOLUMN_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES oDropTarget.ColumnCount = MAX(oDropTarget.ColumnCount + 1, 1) m.oTempObject = oDropTarget.Columns(oDropTarget.ColumnCount) RELEASE oDropTarget m.oDropTarget = m.oTempObject RELEASE m.oTempObject m.lNewColumn = .T. ELSE m.oDropTarget = .NULL. ENDIF ENDIF * determine if the drop target is a valid container * for the object we're trying to drop. We have * special handling for dropping: * - Pages onto pageframes * - Columns onto grids * - Headers onto grid columns * - Option buttons onto option groups DO CASE CASE VARTYPE(oDropTarget) <> 'O' * don't do anything if we don't have a drop target at this point CASE oDropTarget.BaseClass == "Pageframe" AND m.cBaseClass == "Page" TRY m.nMemberCount = 1 IF UPPER(oDropTarget.MemberClassLibrary) == UPPER(m.cClassLib) AND ; (UPPER(oDropTarget.MemberClass) == UPPER(m.cClassName) OR (EMPTY(oDropTarget.MemberClass) AND UPPER(m.cClassName) == "PAGE")) * if the MemberClass is already set, then simply increase the page count oDropTarget.PageCount = oDropTarget.PageCount + 1 ELSE IF MESSAGEBOX(MEMBERCLASS_WARNING_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES oDropTarget.MemberClassLibrary = m.cClassLib oDropTarget.MemberClass = m.cClassName ENDIF ENDIF CATCH TO oException ENDTRY CASE oDropTarget.BaseClass == "Page" AND m.cBaseClass == "Page" TRY IF UPPER(oDropTarget.Parent.MemberClassLibrary) == UPPER(m.cClassLib) AND ; (UPPER(oDropTarget.Parent.MemberClass) == UPPER(m.cClassName) OR (EMPTY(NVL(oDropTarget.Parent.MemberClass, '')) AND UPPER(m.cClassName) == "PAGE")) * if the MemberClass is already set, then simply increase the page count oDropTarget.Parent.PageCount = oDropTarget.Parent.PageCount + 1 ELSE IF MESSAGEBOX(MEMBERCLASS_WARNING_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES m.oParent = m.oDropTarget.Parent m.oDropTarget = .NULL. m.oTopObject = .NULL. * release now because we can't change the parent * MemberClass properties if we have references to * the child page RELEASE m.oDropTarget RELEASE m.oTopObject oParent.MemberClassLibrary = m.cClassLib oParent.MemberClass = m.cClassName oParent.PageCount = 1 ENDIF ENDIF CATCH TO oException ENDTRY CASE oDropTarget.BaseClass == "Grid" AND m.cBaseClass == "Column" TRY IF UPPER(oDropTarget.MemberClassLibrary) == UPPER(m.cClassLib) AND ; (UPPER(oDropTarget.MemberClass) == UPPER(m.cClassName) OR (EMPTY(NVL(oDropTarget.MemberClass, '')) AND UPPER(m.cClassName) == "COLUMN")) * if the MemberClass is already set, then simply increase the page count oDropTarget.ColumnCount = MAX(oDropTarget.ColumnCount, 0) + 1 ELSE IF MESSAGEBOX(MEMBERCLASS_WARNING_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES oDropTarget.MemberClassLibrary = m.cClassLib oDropTarget.MemberClass = m.cClassName ENDIF ENDIF CATCH TO oException ENDTRY CASE oDropTarget.BaseClass == "Optiongroup" AND PROPER(m.cBaseClass) == "Optionbutton" TRY IF UPPER(oDropTarget.MemberClassLibrary) == UPPER(m.cClassLib) AND ; (UPPER(oDropTarget.MemberClass) == UPPER(m.cClassName) OR (EMPTY(NVL(oDropTarget.MemberClass, '')) AND UPPER(m.cClassName) == "OPTIONBUTTON")) * if the MemberClass is already set, then simply increase the page count oDropTarget.ButtonCount = oDropTarget.ButtonCount + 1 ELSE IF MESSAGEBOX(MEMBERCLASS_WARNING_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES oDropTarget.MemberClassLibrary = m.cClassLib oDropTarget.MemberClass = m.cClassName ENDIF ENDIF CATCH TO oException ENDTRY CASE oDropTarget.BaseClass == "Column" AND m.cBaseClass == "Header" TRY IF (UPPER(oDropTarget.HeaderClassLibrary) == UPPER(m.cClassLib) AND ; (UPPER(oDropTarget.HeaderClass) == UPPER(m.cClassName))) * if the HeaderClass is already set, then don't do anything ELSE IF m.lNewColumn OR MESSAGEBOX(HEADERCLASS_WARNING_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES oDropTarget.HeaderClassLibrary = m.cClassLib oDropTarget.HeaderClass = m.cClassName ENDIF ENDIF CATCH TO oException MESSAGEBOX(oException.Message) ENDTRY OTHERWISE IF m.lActiveX * drop ActiveX control oDropTarget.AddObject(m.cObjName, "olecontrol", m.cClassName) ELSE * standard VFP class from a VCX or PRG IF !EMPTY(m.cClassLib) TRY m.cClassLib = LOCFILE(m.cClassLib, JUSTEXT(m.cClassLib)) CATCH m.cClassLib = '' ENDTRY ENDIF * If "ContainerClass" and "ContainerClassLib" are defined as * properties for the class, then we want to use these when * we drop a leaf class -- create the specified container first, * then set the MemberClass/MemberClassLib properties for that container TRY m.cLeafParentClass = THIS.EvalText(m.oPropertyCollection.Item("ContainerClass")) m.cLeafParentClassLib = THIS.EvalText(m.oPropertyCollection.Item("ContainerClassLib")) IF EMPTY(m.cLeafParentClass) OR EMPTY(m.cLeafParentClassLib) OR !FILE(m.cLeafParentClassLib) m.cLeafParentClass = '' m.cLeafParentClassLib = '' ENDIF CATCH m.cLeafParentClass = '' m.cLeafParentClassLib = '' ENDTRY DO CASE CASE m.cBaseClass == "Page" m.cMemberClass = m.cClassName m.cMemberClassLib = m.cClassLib m.cClassName = EVL(m.cLeafParentClass, "Pageframe") m.cClassLib = m.cLeafParentClassLib m.cObjName = THIS.GetUniqueObjName(m.oDropTarget, m.cClassName) CASE m.cBaseClass == "Optionbutton" m.cMemberClass = m.cClassName m.cMemberClassLib = m.cClassLib m.cClassName = EVL(m.cLeafParentClass, "Optiongroup") m.cClassLib = m.cLeafParentClassLib m.cObjName = THIS.GetUniqueObjName(m.oDropTarget, m.cClassName) CASE m.cBaseClass == "Column" m.cMemberClass = m.cClassName m.cMemberClassLib = m.cClassLib m.cClassName = EVL(m.cLeafParentClass, "Grid") m.cClassLib = m.cLeafParentClassLib m.cObjName = THIS.GetUniqueObjName(m.oDropTarget, m.cClassName) CASE m.cBaseClass == "Header" m.cMemberClass = m.cClassName m.cMemberClassLib = m.cClassLib ENDCASE IF EMPTY(m.cClassLib) oDropTarget.AddObject(m.cObjName, m.cClassName) ELSE oDropTarget.NewObject(m.cObjName, m.cClassName, m.cClassLib) ENDIF ENDIF TRY m.oObjRef = oDropTarget.&cObjName CATCH ENDTRY IF VARTYPE(m.oObjRef) == 'O' m.oObjRef.Name = m.cObjName * ActiveX controls don't necessarily have a default width/height IF m.lActiveX IF PEMSTATUS(m.oObjRef, "Width", 5) AND !PEMSTATUS(m.oObjRef, "Width", 1) AND !PEMSTATUS(m.oObjRef, "Width", 2) TRY m.oObjRef.Width = 200 CATCH ENDTRY ENDIF IF PEMSTATUS(m.oObjRef, "Height", 5) AND !PEMSTATUS(m.oObjRef, "Height", 1) AND !PEMSTATUS(m.oObjRef, "Height", 2) TRY m.oObjRef.Height = 150 CATCH ENDTRY ENDIF ELSE * handle creating a container for a dropped leaf class IF !EMPTY(m.cMemberClass) * if we're adding a container for a leaf, * then determine how many leaf classes to add TRY m.nMemberCount = THIS.EvalText(m.oPropertyCollection.Item("MemberCount")) IF VARTYPE(m.nMemberCount) == 'C' m.nMemberCount = VAL(m.nMemberCount) ENDIF IF VARTYPE(m.nMemberCount) <> 'N' m.nMemberCount = 1 ENDIF CATCH m.nMemberCount = 1 ENDTRY DO CASE CASE m.oObjRef.BaseClass == "Pageframe" IF !EMPTY(m.cMemberClassLib) m.oObjRef.MemberClassLibrary = m.cMemberClassLib m.oObjRef.MemberClass = m.cMemberClass ENDIF IF m.nMemberCount <> 0 m.oObjRef.PageCount = m.nMemberCount ENDIF CASE m.oObjRef.BaseClass == "Optiongroup" IF !EMPTY(m.cMemberClassLib) m.oObjRef.MemberClassLibrary = m.cMemberClassLib m.oObjRef.MemberClass = m.cMemberClass ENDIF IF m.nMemberCount <> 0 m.oObjRef.ButtonCount = m.nMemberCount ENDIF CASE m.oObjRef.BaseClass == "Grid" IF !EMPTY(m.cMemberClassLib) m.oObjRef.MemberClassLibrary = m.cMemberClassLib m.oObjRef.MemberClass = m.cMemberClass ENDIF IF m.nMemberCount <> 0 m.oObjRef.ColumnCount = m.nMemberCount ENDIF ENDCASE ENDIF * special handling if we're dropping control on a grid column IF m.oDropTarget.BaseClass == "Column" * -- set the current control if option set to do so IF THIS.oEngine.ColumnSetCurrentControl TRY m.oDropTarget.CurrentControl = m.oObjRef.Name CATCH ENDTRY ENDIF * prompt to remove the Text1 control if it exists IF m.lNewColumn OR THIS.oEngine.ColumnRemoveText1 TRY * see if Text1 exists in grid FOR m.i = 1 TO m.oDropTarget.ControlCount IF m.oDropTarget.Controls(m.i).Name == "Text1" IF m.lNewColumn OR MESSAGEBOX(DROPOBJECT_REMOVETEXT1_LOC, MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2, TOOLBOX_LOC) == IDYES m.oDropTarget.RemoveObject("Text1") ENDIF EXIT ENDIF ENDFOR CATCH ENDTRY ENDIF ENDIF ENDIF ENDIF ENDCASE * error handling in case the object didn't drop CATCH TO oException WHEN oException.ErrorNo == 1429 IF ISNULL(m.oException.Details) MESSAGEBOX(ERROR_INVALIDCONTAINER_LOC, MB_ICONEXCLAMATION, TOOLBOX_LOC) ELSE * parse the OLE error string m.nOLEErrorNo = VAL(STREXTRACT(m.oException.Details, " code ", " from ", 1, 1)) DO CASE CASE m.nOLEErrorNo == 744 && invalid container DOEVENTS MESSAGEBOX(ERROR_INVALIDCONTAINER_LOC, MB_ICONEXCLAMATION, TOOLBOX_LOC) OTHERWISE DOEVENTS MESSAGEBOX(ALLTRIM(SUBSTR(m.oException.Details, AT_C(": ", m.oException.Details) + 1)), MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDCASE ENDIF CATCH TO oException DOEVENTS MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF IF VARTYPE(m.oObjRef) == 'O' TRY IF PEMSTATUS(m.oObjRef, "Left", 5) AND !PEMSTATUS(m.oObjRef, "Left", 1) AND !PEMSTATUS(m.oObjRef, "Left", 2) m.oObjRef.Left = m.nMouseXpos ENDIF CATCH ENDTRY TRY IF PEMSTATUS(m.oObjRef, "Top", 5) AND !PEMSTATUS(m.oObjRef, "Top", 1) AND !PEMSTATUS(m.oObjRef, "Top", 2) m.oObjRef.Top = m.nMouseYPos ENDIF CATCH ENDTRY TRY IF PEMSTATUS(m.oObjRef, "Visible", 5) AND !PEMSTATUS(m.oObjRef, "Visible", 1) AND !PEMSTATUS(m.oObjRef, "Visible", 2) AND !m.oObjRef.Visible m.oObjRef.Visible = .T. ENDIF CATCH ENDTRY * if this is a baseclass, set the AutoSize and then reset it back IF TYPE("m.oObjRef.ClassLibrary") == 'C' AND EMPTY(m.oObjRef.ClassLibrary) AND TYPE("m.oObjRef.AutoSize") == 'L' TRY m.oObjRef.AutoSize = .T. IF TYPE("m.oObjRef.Height") == 'N' TRY m.oObjRef.Height = m.oObjRef.Height CATCH ENDTRY ENDIF IF TYPE("m.oObjRef.Width") == 'N' TRY m.oObjRef.Width = m.oObjRef.Width CATCH ENDTRY ENDIF m.oObjRef.ResetToDefault("AutoSize") CATCH ENDTRY ENDIF * if this is a timer baseclass, adjust the size manually IF TYPE("m.oObjRef.Class") == 'C' AND TYPE("m.oObjRef.BaseClass") == 'C' AND m.oObjRef.Class == "Timer" AND m.oObjRef.BaseClass == "Timer" IF TYPE("m.oObjRef.Height") == 'N' TRY m.oObjRef.Height = 23 CATCH ENDTRY ENDIF IF TYPE("m.oObjRef.Width") == 'N' TRY m.oObjRef.Width = 23 CATCH ENDTRY ENDIF ENDIF * -- set any properties specified by "properties" FOR m.i = 1 TO m.oPropertyCollection.Count m.cPropertyName = m.oPropertyCollection.GetKey(m.i) m.cPropertyValue = TRANSFORM(m.oPropertyCollection.Item(m.i)) IF !EMPTY(m.cPropertyName) IF UPPER(m.cPropertyValue) == ".T." OR UPPER(m.cPropertyValue) == ".F." m.cDataType = 'L' ELSE m.cDataType = TYPE("m.oObjRef." + m.cPropertyName) ENDIF TRY DO CASE CASE m.cDataType == 'N' m.oObjRef.&cPropertyName = VAL(m.cPropertyValue) CASE m.cDataType == 'L' m.oObjRef.&cPropertyName = (UPPER(m.cPropertyValue) == ".T." OR UPPER(m.cPropertyValue) == "T") OTHERWISE m.oObjRef.&cPropertyName = m.cPropertyValue ENDCASE CATCH ENDTRY ENDIF ENDFOR DOEVENTS IF !m.lNoDrag IF VARTYPE(m.oTopObject) == 'O' AND !EMPTY(m.cActiveWindow) AND WEXIST(m.cActiveWindow) IF TYPE("m.oObjRef.Top") <> 'N' * no Top property on this control, so assume it's in the upper left corner m.nMouseYPos = 0 m.nMouseXPos = 0 ENDIF ENDIF ENDIF IF !m.lNoDrag AND m.oDropTarget.BaseClass <> "Column" DOEVENTS MOUSE CLICK AT m.nScreenRow, m.nScreenCol PIXELS SHIFT CONTROL * if we're dropping a container object, we need to SHIFT-CTRL click outside * of it to deselect it so we're not drilled into (halo effect) by default, and * then do a regular click directly on it to select it again IF INLIST(m.oObjRef.BaseClass, "Container", "Commandgroup", "Pageframe", "Optiongroup", "Grid") DOEVENTS * click in an area outside the container * the CASE statement determines whether we have * room to the left or the top to click DO CASE CASE m.nMouseXPos > 2 MOUSE CLICK AT m.nScreenRow, m.nScreenCol-3 PIXELS SHIFT CONTROL CASE m.nMouseYPos > 2 MOUSE CLICK AT m.nScreenRow - 3, m.nScreenCol PIXELS SHIFT CONTROL ENDCASE DOEVENTS MOUSE CLICK AT m.nScreenRow, m.nScreenCol PIXELS ENDIF DOEVENTS ENDIF DOEVENTS IF PEMSTATUS(m.oDropTarget, "Refresh", 5) m.oDropTarget.Refresh() ENDIF IF VARTYPE(m.oFormObject) == 'O' TRY IF m.nScaleMode == -1 m.oFormObject.ResetToDefault("ScaleMode") ELSE m.oFormObject.ScaleMode = m.nScaleMode ENDIF CATCH ENDTRY ENDIF IF VARTYPE(m.cDETable) == 'C' AND !EMPTY(m.cDETable) THIS.AddToDataEnv(m.oDropTarget, m.cDETable) ENDIF * 'Y' = always run builder, 'N' = never run builder, anything else makes it default to the BuilderLock setting IF VARTYPE(THIS.RunBuilder) == 'C' m.cRunBuilder = UPPER(THIS.RunBuilder) ELSE m.cRunBuilder = '' ENDIF * If there is a custom property called "_drophook", then * execute that script code after dropping but before running the * builder. If it returns FALSE, then don't run the * builder regardless of the cRunBuilder setting TRY m.cDropScript = THIS.EvalText(m.oPropertyCollection.Item("_drophook")) IF VARTYPE(m.cDropScript) == 'C' AND !EMPTY(m.cDropScript) TRY IF INLIST(LOWER(JUSTEXT(m.cDropScript)), "prg", "fxp", "mpr", "qpr", "app") AND FILE(m.cDropScript) m.lRetValue = EXECSCRIPT(FILETOSTR(m.cDropScript), m.oObjRef) ELSE m.lRetValue = EXECSCRIPT(m.cDropScript) ENDIF IF VARTYPE(m.lRetValue) == 'L' AND !m.lRetValue m.cRunBuilder = 'N' ENDIF CATCH TO oException MESSAGEBOX(ERROR_DROPHOOK_LOC + CHR(10) + CHR(10)+ m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF CATCH * ignore error -- we exepect an error if no _drophook property is defined ENDTRY IF (m.cRunBuilder == 'Y' OR (m.cRunBuilder <> 'N' AND THIS.oEngine.BuilderLock)) AND !EMPTY(_builder) AND FILE(_builder) IF m.lNoDrag m.nDataSession = SET("DATASESSION") SET DATASESSION TO 1 DO (_Builder) WITH m.oObjRef, "TOOLBOX" SET DATASESSION TO (m.nDataSession) ELSE * delay running of builder when drag/dropped so we can * get out of the OLECompleteDrag() event before it executes THIS.oEngine.Builder() ENDIF ENDIF ENDIF m.oObjRef =.NULL. ENDIF ENDIF RELEASE m.oDropTarget RELEASE m.oTopObject RELEASE m.oFormObject RELEASE m.oObjRef ENDPROC PROCEDURE parsetooldata * Parse whatever is in the ToolData property, * loading up the DataValue collection appropriately LPARAMETERS cToolData LOCAL cValue IF THIS.lToolDataParsed * RETURN ENDIF IF VARTYPE(m.cToolData) <> 'C' m.cToolData = THIS.ToolData ENDIF IF !EMPTY(m.cToolData) LOCAL oDataValue FOR EACH oDataValue IN THIS.oDataCollection IF ATC('<' + oDataValue.DataName + '>', m.cToolData) > 0 m.cValue = STREXTRACT(m.cToolData, '<' + oDataValue.DataName + '>', '') DO CASE CASE m.cValue == ".T." THIS.SetDataValue(oDataValue.DataName, .T.) CASE m.cValue == ".F." THIS.SetDataValue(oDataValue.DataName, .F.) OTHERWISE THIS.SetDataValue(oDataValue.DataName, m.cValue) ENDCASE ENDIF ENDFOR oDataValue = .NULL. ENDIF THIS.lToolDataParsed = .T. RETURN ENDPROC PROCEDURE oncreatedatavalues * Call AddDateValue() for each of the attributes you want * to track for this category/tool. The format for AddDataValue * is as follows: * * THIS.AddDataValue(, , , , , , , ) * ENDPROC PROCEDURE encodetooldata * Encode the Data Values #include "toolbox.h" LOCAL oDataValue LOCAL cEncoded m.cEncoded = '' * gather the data properties for this class FOR EACH oDataValue IN THIS.oDataCollection m.cEncoded = m.cEncoded + '<' + oDataValue.DataName + '>' + TRANSFORM(oDataValue.DataValue) + "" + CHR(10) ENDFOR oDataValue = .NULL. RETURN m.cEncoded ENDPROC PROCEDURE getimagefile RETURN '' ENDPROC PROCEDURE gethelpfile * -- Show help for this item RETURN THIS.HelpFile ENDPROC PROCEDURE oncreate * Put code in here to do when an item is * added in the Customize dialog. * For example, for File types, we might * ask what type of file to add. * Return FALSE if item should not be created. RETURN .T. ENDPROC PROCEDURE onkeypress LPARAMETERS nKeyCode, nShiftAltCtrl * return TRUE issues a NODEFAULT RETURN .F. ENDPROC PROCEDURE tooldata_access *To do: Modify this routine for the Access method RETURN THIS.EncodeToolData() ENDPROC PROCEDURE tooldata_assign LPARAMETERS cToolData * THIS.ToolData = m.cToolData THIS.ToolData = THIS.ParseToolData(m.cToolData) RETURN THIS.ToolData ENDPROC PROCEDURE getopenforms * Return a collection of open VCX/SCX designer windows #include "toolbox.h" LOCAL nTotalWindows LOCAL i LOCAL oWindowCollection LOCAL cWinName LOCAL ARRAY aTmpArray[1] m.oWindowCollection = CREATEOBJECT("Collection") m.nTotalWindows = WCHILD("SCREEN") DIMENSION aTmpArray[m.nTotalWindows] FOR m.i = 1 TO m.nTotalWindows aTmpArray[m.i] = WCHILD("SCREEN", m.i - 1) ENDFOR FOR m.i = m.nTotalWindows TO 1 STEP -1 m.cWinName = aTmpArray[m.i] DO CASE CASE ATCC(WIN_SCX_DESIGN_LOC, m.cWinName) <> 0 m.cWinName = LOWER(SUBSTRC(m.cWinName, LENC(WIN_SCX_DESIGN_LOC) + 2)) CASE ATCC(WIN_VCX_DESIGN_LOC, m.cWinName) <> 0 m.cWinName = LOWER(SUBSTRC(m.cWinName, LENC(WIN_VCX_DESIGN_LOC) + 2)) OTHERWISE m.cWinName = '' ENDCASE IF !EMPTY(m.cWinName) m.oWindowCollection.Add(m.cWinName) ENDIF ENDFOR RETURN m.oWindowCollection ENDPROC PROCEDURE invokeaddin * -- Invoke an add-in. * -- Assumes the Add-In class has a method called: Execute(oToolItem) #include "foxpro.h" #include "toolbox.h" LPARAMETERS cUniqueID, p1, p2, p3, p4 DO CASE CASE PCOUNT() == 5 THIS.oEngine.InvokeAddIn(m.cUniqueID, THIS, m.p1, m.p2, m.p3, m.p4) CASE PCOUNT() == 4 THIS.oEngine.InvokeAddIn(m.cUniqueID, THIS, m.p1, m.p2, m.p3) CASE PCOUNT() == 3 THIS.oEngine.InvokeAddIn(m.cUniqueID, THIS, m.p1, m.p2) CASE PCOUNT() == 2 THIS.oEngine.InvokeAddIn(m.cUniqueID, THIS, m.p1) OTHERWISE THIS.oEngine.InvokeAddIn(m.cUniqueID, THIS) ENDCASE ENDPROC PROCEDURE parsepropertylist * given a property list in the below format, parse * it into a collection object * * AutoSize=.T. * Name=MyForm1 * LPARAMETERS cPropertyList LOCAL i LOCAL nCnt LOCAL nPos LOCAL cPropertyName LOCAL cPropertyValue LOCAL oPropertyCollection LOCAL ARRAY aPropertyList[1] m.oPropertyCollection = CREATEOBJECT("Collection") IF !EMPTY(m.cPropertyList) m.nCnt = ALINES(aPropertyList, m.cPropertyList, .F., CHR(10)) FOR m.i = 1 TO m.nCnt m.nPos = AT('=', aPropertyList[m.i]) IF m.nPos > 1 m.cPropertyName = LEFT(aPropertyList[m.i], m.nPos - 1) m.cPropertyValue = SUBSTR(aPropertyList[m.i], m.nPos + 1) IF !EMPTY(m.cPropertyName) m.cPropertyValue = THIS.EvalText(m.cPropertyValue) IF !EMPTY(m.cPropertyValue) TRY m.oPropertyCollection.Add(m.cPropertyValue, m.cPropertyName) CATCH ENDTRY ENDIF ENDIF ENDIF ENDFOR ENDIF RETURN m.oPropertyCollection ENDPROC PROCEDURE getuniqueobjname * Given the drop target object, and the original name * we want to use, add a numeric indentifier to the * end until we find a unique name on the target object #include "toolbox.h" LPARAMETERS oDropTarget, cOriginalObjName LOCAL i LOCAL cObjName m.cOriginalObjName = CHRTRAN(ALLTRIM(m.cOriginalObjName), INVALID_OBJNAME_CHARS, '') IF !ISALPHA(m.cOriginalObjName) OR (LEFT(m.cOriginalObjName, 1) == '_') m.cOriginalObjName = 'o' + m.cOriginalObjName ENDIF m.i = 1 m.cObjName = m.cOriginalObjName + TRANSFORM(m.i) DO WHILE .T. IF TYPE("oDropTarget.&cObjName.") = "U" EXIT ENDIF m.i = m.i + 1 m.cObjName = m.cOriginalObjName + TRANSFORM(m.i) ENDDO RETURN m.cObjName ENDPROC PROCEDURE addclasslib * Add a new category IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.AddClassLib() ENDIF ENDPROC PROCEDURE addtofavorites * Add to favorites IF VARTYPE(THIS.oEngine) == 'O' THIS.oEngine.AddToFavorites(THIS.UniqueID) ENDIF ENDPROC PROCEDURE showhelp LOCAL cHelpCmd LOCAL cHelpFile LOCAL cSaveHelpFile m.cSaveHelpFile = SET("HELP", 1) IF !EMPTY(THIS.HelpFile) AND FILE(THIS.HelpFile) TRY SET HELP TO (THIS.HelpFile) CATCH ENDTRY ENDIF m.cHelpCmd = "HELP NOWAIT" IF THIS.HelpID > 0 m.cHelpCmd = [HELP ID ] + TRANSFORM(THIS.HelpID) + [ NOWAIT] ENDIF &cHelpCmd IF EMPTY(m.cSaveHelpFile) OR !FILE(m.cSaveHelpFile) * if there is no help file setup, we * may get an error here, so wrap in try/catch TRY SET HELP TO CATCH ENDTRY ELSE SET HELP TO (m.cSaveHelpFile) ENDIF ENDPROC PROCEDURE getregistryvalue * Simple way to return a registry value * Mainly used for retrieving IntelliDrop class and library #include "toolbox.h" LPARAMETERS cOption, cKeyPath, cDefault LOCAL oRec LOCAL cValue IF PCOUNT() < 3 m.cDefault = '' ENDIF IF VARTYPE(cKeyPath) <> 'C' OR EMPTY(m.cKeyPath) RETURN m.cDefault ENDIF IF VARTYPE(m.cOption) <> 'C' OR EMPTY(m.cOption) RETURN m.cDefault ENDIF m.cValue = '' TRY oReg = NEWOBJECT("registry", "toolboxregistry.vcx", _TOOLBOX) IF oReg.GetRegKey(m.cOption, @cValue, m.cKeyPath, HKEY_CURRENT_USER) <> 0 m.cValue = m.cDefault ENDIF CATCH m.cValue = m.cDefault ENDTRY RETURN m.cValue ENDPROC PROCEDURE addtodataenv * Add a table to the dataenvironment LPARAMETERS oDropTarget, cTable LOCAL oDE LOCAL nCnt LOCAL oObjRef LOCAL cObjName LOCAL nCnt LOCAL i LOCAL cSource LOCAL cDatabase LOCAL cAlias LOCAL nSelect LOCAL oForm LOCAL nDataSessionID LOCAL lOpenTable LOCAL ARRAY aInUse[1] LOCAL ARRAY aDataEnv[1] LOCAL ARRAY aChildren[1] m.oForm = m.oDropTarget DO WHILE TYPE("m.oForm") == 'O' AND !ISNULL(m.oForm) AND !(m.oForm.BaseClass == "Form") m.oForm = m.oForm.Parent ENDDO IF VARTYPE(m.oForm) <> 'O' OR !(m.oForm.BaseClass == "Form") RELEASE m.oForm RETURN ENDIF m.nSelect = SELECT() m.nDataSessionID = SET("DataSession") SET DATASESSION TO (m.oForm.DataSessionID) * determine if this table is already open m.cAlias = '' m.cTable = LOWER(m.cTable) m.nCnt = AUSED(aInUse) FOR m.i = 1 TO m.nCnt IF LOWER(DBF(aInUse[m.i, 1])) == m.cTable m.cAlias = aInUse[m.i, 1] EXIT ENDIF ENDFOR * if table isn't already open, then open it m.lOpenTable = EMPTY(m.cAlias) IF m.lOpenTable SELECT 0 TRY USE (m.cTable) SHARED AGAIN m.cAlias = ALIAS() CATCH m.cAlias = '' ENDTRY ENDIF IF !EMPTY(m.cAlias) m.cDatabase = LOWER(CURSORGETPROP("DATABASE", m.cAlias)) m.cSource = LOWER(CURSORGETPROP("SOURCENAME", m.cAlias)) m.nCnt = ASELOBJ(aDataEnv, 2) IF m.nCnt > 0 m.oDE = aDataEnv[1] RELEASE aDataEnv IF VARTYPE(m.oDE) == 'O' * don't add if we already have a cursor based upon the same table m.nCnt = AMEMBERS(aChildren, m.oDE, 2) FOR m.i = 1 TO m.nCnt m.cObjName = aChildren[m.i] TRY m.oObjRef = m.oDE.&cObjName CATCH ENDTRY IF VARTYPE(m.oObjRef) == 'O' AND m.oObjRef.BaseClass == "Cursor" AND m.oObjRef.CursorSource == m.cSource AND m.oObjRef.Database == m.cDatabase RELEASE oObjRef RELEASE m.oForm SELECT (m.nSelect) RETURN ENDIF ENDFOR m.cObjName = THIS.GetUniqueObjName(m.oDE, "Cursor") m.oDE.AddObject(m.cObjName, "Cursor") TRY m.oObjRef = m.oDE.&cObjName CATCH ENDTRY IF VARTYPE(m.oObjRef) == 'O' m.oObjRef.Alias = LOWER(ALIAS()) m.oObjRef.CursorSource = m.cSource IF !EMPTY(m.cDatabase) m.oObjRef.Database = m.cDatabase ENDIF ENDIF m.oObjRef = .NULL. ENDIF ENDIF IF m.lOpenTable USE IN (m.cAlias) ENDIF RELEASE m.oDE ENDIF RELEASE m.oObjRef RELEASE m.oForm SET DATASESSION TO (m.nDataSessionID) SELECT (m.nSelect) ENDPROC PROCEDURE createaddinsmenu * Update passed in context menu with add-in items, * displaying submenu items by calling this recursively #include "foxpro.h" #include "toolbox.h" LPARAMETERS oContextMenu, cToolTypeID, cParentID LOCAL oAddInCollection LOCAL oAddIn LOCAL oMenuItem LOCAL oException oAddInCollection = THIS.oEngine.GetAddIns(m.cToolTypeID, m.cParentID) IF oAddInCollection.Count > 0 IF EMPTY(m.cParentID) oContextMenu.Addmenu("\-") ENDIF FOR EACH oAddIn IN oAddInCollection IF oAddIn.IsMenu oMenuItem = oContextMenu.AddMenu(oAddIn.AddInName) IF !EMPTY(oAddIn.MenuCode) TRY EXECSCRIPT(oAddIn.MenuCode, THIS, oMenuItem.SubMenu) CATCH TO oException MESSAGEBOX(m.oException.Message, MB_ICONEXCLAMATION, TOOLBOX_LOC) ENDTRY ENDIF THIS.CreateAddInsMenu(oMenuItem.SubMenu, m.cToolTypeID, oAddIn.UniqueID) ELSE oMenuItem = oContextMenu.AddMenu(oAddIn.AddInName, [oRef.InvokeAddIn("] + oAddIn.UniqueID + [")]) ENDIF ENDFOR ENDIF ENDPROC PROCEDURE Destroy THIS.oDataCollection = .NULL. THIS.oEngine = .NULL. ENDPROC PROCEDURE Init DODEFAULT() THIS.oDataCollection = CREATEOBJECT("Collection") THIS.OnCreateDataValues() THIS.ToolData = THIS.ToolData ENDPROC